Các câu hỏi về mảng trong VBA (Array)

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

keke355992 · 8/9/15

giangleloi đã viết:
Tôi không nghĩ vấn đề chỉ theo một hướng đó. Nếu biêt tại sao thì bác cứ giải thích tại sao là tại sao đi? Tôi "gà mờ" nên chịu thôi.

Dạ ý em đúng là hỏi vì sao thao tác trên combo Box lại k đc ghi lại trên Macro đó ạ. E cũng tìm hỉu gg rùi mà k ra đc

Hoàng Trọng Nghĩa · 8/9/15

keke355992 đã viết:
Dạ ý em đúng là hỏi vì sao thao tác trên combo Box lại k đc ghi lại trên Macro đó ạ. E cũng tìm hỉu gg rùi mà k ra đc

Không phải lúc nào cũng ghi macro được đâu. Những thao tác trên các Controls càng không ghi được. Vì thế phải học VBA để thao tác.

khongnhienttt · 8/9/15

cho em hỏi ngu cái ạ ví dụ:
dim Arr, Arr1()
- thì Arr là mảng các variant, còn Arr1 là mảng
vậy tại sao ta cho: Arr=range("A1","C5") được mà không làm được như vậy với Arr1, xin các bạn chỉ giáo

Let'GâuGâu · 8/9/15

khongnhienttt đã viết:
cho em hỏi ngu cái ạ ví dụ:
dim Arr, Arr1()
- thì Arr là mảng các variant, còn Arr1 là mảng
vậy tại sao ta cho: Arr=range("A1","C5") được mà không làm được như vậy với Arr1, xin các bạn chỉ giáo

vậy nó báo lổi gì??? tôi thấy nó nhận giá trị tuốt luốt mà???

Hoàng Trọng Nghĩa · 8/9/15

khongnhienttt đã viết:
cho em hỏi ngu cái ạ ví dụ:
dim Arr, Arr1()
- thì Arr là mảng các variant, còn Arr1 là mảng
vậy tại sao ta cho: Arr=range("A1","C5") được mà không làm được như vậy với Arr1, xin các bạn chỉ giáo

Làm gì mà không gán được!

Mã:

Sub test()
    Dim Arr, Arr1()
    Arr1 = Range("A1", "C5")
    MsgBox UBound(Arr1, 1)
End Sub

khongnhienttt · 8/9/15

do mình chọn vị trí ra ngoài kích thước mảng, nhưng nhờ các bạn giải thích Arr và Arr1() khác nhau chỗ nào nhỉ, và khai báo cái nào code chạy nhanh hơn

Hoàng Trọng Nghĩa · 8/9/15

khongnhienttt đã viết:
mình viết kiểu này nó báo lỗi

Mã:

Sub xuly() Dim arr, arr1() With Sheet1 arr1 = .Range("a1", Range("b65000").End(xlUp)) End With MsgBox arr1(2, 3) End Sub

Nếu cột B không có dữ liệu, thì Arr1=Range("A1:B1"), tức chỉ 1 hàng, 2 cột, vậy làm sao có thể có Arr1(2, 3) được? Đó là nói về hàng, nói về cột thì A và B chỉ 2 cột, lấy ở đâu ra cột thứ 3?

khongnhienttt · 8/9/15

Hoàng Trọng Nghĩa đã viết:
Nếu cột B không có dữ liệu, thì Arr1=Range("A1:B1"), tức chỉ 1 hàng, 2 cột, vậy làm sao có thể có Arr1(2, 3) được? Đó là nói về hàng, nói về cột thì A và B chỉ 2 cột, lấy ở đâu ra cột thứ 3?

thank bạn mình đã sửa lại bài bên trên và có 1 câu hỏi mong bạn giải đáp

Ba Tê · 8/9/15

khongnhienttt đã viết:
do mình chọn vị trí ra ngoài kích thước mảng, nhưng nhờ các bạn giải thích Arr và Arr1() khác nhau chỗ nào nhỉ, và khai báo cái nào code chạy nhanh hơn

Xem và so với cái này coi có chỗ nào khác nhau không:

With Sheet1
arr1 = .Range("a1", Range("b65000").End(xlUp))
End With

With Sheet1
arr1 = .Range("a1", .Range("b65000").End(xlUp)).Value
End With

Cái mảng arr1() chỉ có cột A và B
MsgBox arr1(2, 3), cái số 3 này từ đâu ra?

doveandrose · 8/9/15

a em thấy rồi cái dưới có .Value cái trên hổng có . hihi

Hoàng Trọng Nghĩa · 8/9/15

khongnhienttt đã viết:
do mình chọn vị trí ra ngoài kích thước mảng, nhưng nhờ các bạn giải thích Arr và Arr1() khác nhau chỗ nào nhỉ, và khai báo cái nào code chạy nhanh hơn

Khác hẳn, Với Arr là một biến Variant, tức ta có thể gán bất cứ thứ gì cho nó cũng được, dạng chuỗi, dạng số, dạng mảng v.v..., nhưng Arr1() là biến mảng, ta chỉ được gán dữ liệu dạng mảng cho nó mà thôi.

Một thử nghiệm nho nhỏ:

Mã:

Sub Test()
    Dim Arr, Arr1()
    Arr = Range("A1")
    MsgBox "OK"
    Arr1 = Range("A1")
    MsgBox "OK"
End Sub

Với lần chạy cho Arr thì OK, nhưng Arr1 thì lỗi.

Ba Tê · 8/9/15

doveandrose đã viết:
a em thấy rồi cái dưới có .Value cái trên hổng có . hihi

Còn 1 chỗ khác nhau nữa...

doveandrose · 8/9/15

Ba Tê đã viết:
Còn 1 chỗ khác nhau nữa...

cái dưới nhiều hơn cái trên 2 dấu chấm . hí hí

hong loi · 30/10/15

Em chào các Thầy và các anh ! Sau khi thêm bớt hoặc chỉnh sửa tên trong danh sách, để tự động đánh dấu(tô màu) những tên trong danh sách Cột B không có trong danh sách cột O em dùng code này.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
   Dim CompareRange1 As Range, CompareRange2 As Range, x As Range
   Dim DongCuoiB As Integer, DongCuoiO As Integer
    DongCuoiB = [B65000].End(xlUp).Row
    DongCuoiO = [O65000].End(xlUp).Row
    Set CompareRange1 = Range("B2").Resize(DongCuoiB - 1, 1)
    Set CompareRange2 = Range("O2").Resize(DongCuoiO, 1)
    If Not Intersect(Target, CompareRange1) Is Nothing Then
        CompareRange1.Interior.ColorIndex = xlNone
        For Each x In CompareRange1
            If Application.WorksheetFunction.CountIf(CompareRange2, x) < 1 Then
                If x.Value Like " *" Then
                    x.Interior.ColorIndex = 15
                    Else: x.Interior.ColorIndex = 34
                End If
            End If
        Next x
    End If
End If
End Sub

Nhưng khi dùng cho danh sách có đến 2500 dòng thì code chạy nặng chậm. Em thấy đề tài này có nói đến dùng mảng Array để tăng tốc độ xử lý, nay em xin các Thầy cùng các bạn giúp em cải thiện tốc độ chạy code trên nhé ? Em rất cám ơn ạ.

Nếu bài hỏi này không đúng chổ em xin mọi người góp ý để em chuyển bài đến đúng chủ đề nhé em xin cám ơn.

ndu96081631 · 31/10/15

hong loi đã viết:
Nhưng khi dùng cho danh sách có đến 2500 dòng thì code chạy nặng chậm. Em thấy đề tài này có nói đến dùng mảng Array để tăng tốc độ xử lý, nay em xin các Thầy cùng các bạn giúp em cải thiện tốc độ chạy code trên nhé ? Em rất cám ơn ạ.

Nếu bài hỏi này không đúng chổ em xin mọi người góp ý để em chuyển bài đến đúng chủ đề nhé em xin cám ơn.

Thử code vầy xem tốc độ thế nào:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      End If
    Next
  End If
End Sub

hong loi · 31/10/15

ndu96081631 đã viết:

Thử code vầy xem tốc độ thế nào:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      End If
    Next
  End If
End Sub

Wao... Tốc độ nhanh hơn gấp đôi rồi Thầy ơi. Em cám ơn Thầy nhiều nhiều. À Thầy ơi em muốn thêm đoạn code này nhưng em không biết phải thêm như thế nào cho tốc độ vẫn nhanh.

Mã:

' [COLOR=#ff8c00]Khi xóa tên --> màu và các dử liệu cùng dòng cũng xóa theo[/COLOR]
On Error Resume Next
    If Target = "" Then 
        With Target.Offset(, -1).Resize(, 7)
            .ClearContents
            .Interior.ColorIndex = xlNone
        End With
    End If

Em xin Thầy ghép vào giúp nhé.

ndu96081631 · 31/10/15

hong loi đã viết:
Wao... Tốc độ nhanh hơn gấp đôi rồi Thầy ơi. Em cám ơn Thầy nhiều nhiều. À Thầy ơi em muốn thêm đoạn code này nhưng em không biết phải thêm như thế nào cho tốc độ vẫn nhanh.

Mã:

' [COLOR=#ff8c00]Khi xóa tên --> màu và các dử liệu cùng dòng cũng xóa theo[/COLOR] On Error Resume Next If Target = "" Then With Target.Offset(, -1).Resize(, 7) .ClearContents .Interior.ColorIndex = xlNone End With End If

Em xin Thầy ghép vào giúp nhé.

Có thể là vầy chăng

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      [COLOR=#ff0000]Else
        x.Offset(, -1).ClearContents
        x.Offset(, 1).Resize(, 5).ClearContents
        x.Offset(, -1).Resize(, 7).Interior.ColorIndex = xlNone
      End If[/COLOR]
    Next
  End If
End Sub

Let'GâuGâu · 31/10/15

hong loi đã viết:
Em chào các Thầy và các anh ! Sau khi thêm bớt hoặc chỉnh sửa tên trong danh sách, để tự động đánh dấu(tô màu) những tên trong danh sách Cột B không có trong danh sách cột O em dùng code này.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Dim CompareRange1 As Range, CompareRange2 As Range, x As Range Dim DongCuoiB As Integer, DongCuoiO As Integer DongCuoiB = [B65000].End(xlUp).Row DongCuoiO = [O65000].End(xlUp).Row Set CompareRange1 = Range("B2").Resize(DongCuoiB - 1, 1) Set CompareRange2 = Range("O2").Resize(DongCuoiO, 1) If Not Intersect(Target, CompareRange1) Is Nothing Then CompareRange1.Interior.ColorIndex = xlNone For Each x In CompareRange1 If Application.WorksheetFunction.CountIf(CompareRange2, x) < 1 Then If x.Value Like " *" Then x.Interior.ColorIndex = 15 Else: x.Interior.ColorIndex = 34 End If End If Next x End If End If End Sub

Nhưng khi dùng cho danh sách có đến 2500 dòng thì code chạy nặng chậm. Em thấy đề tài này có nói đến dùng mảng Array để tăng tốc độ xử lý, nay em xin các Thầy cùng các bạn giúp em cải thiện tốc độ chạy code trên nhé ? Em rất cám ơn ạ.

Nếu bài hỏi này không đúng chổ em xin mọi người góp ý để em chuyển bài đến đúng chủ đề nhé em xin cám ơn.

ngồi nhổ râu riết trụi lũi rồi..........hihihihi
góp tí cho vui

Mã:

Sub hello()
Dim Cot_O, Cot_B As Variant, i, j, k As Long, dic As Object, st_1, st_2 As String
Cot_O = [o2:o20]
Cot_B = Range([B2], [B2].End(4)).Value
Range([B2], [B2].End(4)).Interior.ColorIndex = xlNone
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Cot_O)
    If Not dic.exists(Cot_O(i, 1)) Then dic.Add (Cot_O(i, 1)), ""
Next
For i = 1 To UBound(Cot_B)
j = i + 1
    If Left(Cot_B(i, 1), 1) = Space(1) Then
        If Len(st_1) Then st_1 = st_1 & "," & "B" & j Else st_1 = "B" & j
    Else
        If Not dic.exists(Cot_B(i, 1)) Then
            If Len(st_2) Then st_2 = st_2 & "," & "B" & j Else st_2 = "B" & j
       End If
    End If
Next
Range(st_1).Interior.ColorIndex = 15
Range(st_2).Interior.ColorIndex = 34

End Sub

hong loi · 1/11/15

ndu96081631 đã viết:

Có thể là vầy chăng

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      [COLOR=#ff0000]Else
        x.Offset(, -1).ClearContents
        x.Offset(, 1).Resize(, 5).ClearContents
        x.Offset(, -1).Resize(, 7).Interior.ColorIndex = xlNone
      End If[/COLOR]
    Next
  End If
End Sub

Em cám ơn Thầy đã giúp, Em test rồi tốc độ vẫn đảm bảo. Em cũng test code 2, nếu chỉ xóa 1 tên tốc độ vẫn tương đương với code của Thầy.

code 2

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      End If
    Next
    [COLOR=#ff8c00]On Error Resume Next
    If Target = "" Then
        Target.Offset(, -1).ClearContents
        Target.Offset(, 1).Resize(, 5).ClearContents
        Target.Offset(, -1).Resize(, 7).Interior.ColorIndex = xlNone
    End If[/COLOR]
End If
End Sub

Nhưng nếu quét khối xóa một lược nhiều tên (khoảng 3 tên trở lên) --> code 2 nhanh hơn, em đoán nguyên nhân do phần code màu cam không nằm trong vòng lặp, có phải vậy không Thầy ?

hong loi · 1/11/15

Let'GâuGâu đã viết:

ngồi nhổ râu riết trụi lũi rồi..........hihihihi
góp tí cho vui

Mã:

Sub hello()
Dim Cot_O, Cot_B As Variant, i, j, k As Long, dic As Object, st_1, st_2 As String
Cot_O = [o2:o20]
Cot_B = Range([B2], [B2].End(4)).Value
Range([B2], [B2].End(4)).Interior.ColorIndex = xlNone
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Cot_O)
    If Not dic.exists(Cot_O(i, 1)) Then dic.Add (Cot_O(i, 1)), ""
Next
For i = 1 To UBound(Cot_B)
j = i + 1
    If Left(Cot_B(i, 1), 1) = Space(1) Then
        If Len(st_1) Then st_1 = st_1 & "," & "B" & j Else st_1 = "B" & j
    Else
        If Not dic.exists(Cot_B(i, 1)) Then
            If Len(st_2) Then st_2 = st_2 & "," & "B" & j Else st_2 = "B" & j
       End If
    End If
Next
Range(st_1).Interior.ColorIndex = 15
Range(st_2).Interior.ColorIndex = 34

End Sub

Cám ơn anh Let'GâuGâu giúp em, anh xem code anh viết hình như còn thiếu cái gì đó, chạy code báo lổi này.

Các câu hỏi về mảng trong VBA (Array)

Thành viên gắn bó

Thành viên thường trực

Chuyên gia GPE

Thành viên hoạt động

Thành viên mới

Chuyên gia GPE

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

Cạo Rồi Khỏi Gội

hello

Chuyên gia GPE

Cạo Rồi Khỏi Gội

hello

Thành viên hoạt động

File đính kèm

Huyền thoại GPE

Thành viên hoạt động

Huyền thoại GPE

Thành viên mới

Thành viên hoạt động

Thành viên hoạt động