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

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ị

phuyen89 · 22/5/17

ndu96081631 đã viết:
Khai báo vậy thì sArray là biến Variant, nó có thể là bất cứ thứ gì nên đương nhiên nó cũng có thể là mảng được và khi bạn "nạp" Range("A1:A808945") vào, nó sẽ trở thành mảng (tức là tùy bạn nạp thứ gì vào thì nó sẽ trở thành thứ ấy)
Nếu khai báo sArray() thì nó chỉ là biến mảng với số lượng phần tử chưa biết trước... và đương nhiên nó không thể trở thành "thứ khác" được (chỉ có thể là mảng thôi). Lấy ví dụ:
- Từ A1 đến A10 đang có dữ liệu nào đó
- Giờ ta khai báo Dim arr() đồng thời nạp giá trị A1:A10 vào nó

Mã:

Dim arr() arr = Range("A1:A10").Value

- Mọi thứ chạy bình thường không lỗi
- Nhưng nếu bạn sửa lại:

Mã:

Dim arr() arr = Range("A1").Value

Thì lỗi ngay lập tức. Bởi 1 cell duy nhất A1 thì không thể là mảng được. Trong khi nếu khai báo Dim arr (không có cặp dấu ngoặc) thì cả 2 code đều không lỗi

Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr()
    Dim ArrayName()
    Dim sTen As String
    sTen = "Nguyen Ngoc Chung"
    ArrayName = Split(sTen, " ")
End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

befaint · 22/5/17

phuyen89 đã viết:
Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr() Dim ArrayName() Dim sTen As String sTen = "Nguyen Ngoc Chung" ArrayName = Split(sTen, " ") End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

Thử như vầy xem:

PHP:

Sub Arr()
    Dim ArrayName()
    Dim sTen As String
    sTen = "Nguyen Ngoc Chung"
'    ArrayName = Split(sTen, " ")
    MsgBox TypeName(Split(sTen, " "))
End Sub

ndu96081631 · 22/5/17

phuyen89 đã viết:
Em có thử một đoạn code sau, nhưng không hiểu vì sao lại bị lỗi.

PHP:

Sub Arr() Dim ArrayName() Dim sTen As String sTen = "Nguyen Ngoc Chung" ArrayName = Split(sTen, " ") End Sub

- Biến ArrayName() là một mảng động, sau khi hàm Split tách ra thì nó có 3 phần tử, Em add vào mảng này, nhưng bị thông báo lỗi "Type missmatch"
- Nhưng nếu em đổi lại ArrayName()-->ArrayName (biến variant) or -->ArrayName() as String thì nó lại chạy hoàn toàn bình thường.
Mong các anh giup đỡ.

- Khi bạn khai báo Dim ArrayName() thì có nghĩa biến ArrayName chính là 1 array mà các phần tử bên trong (nếu sau này nạp vào) được khai báo dạng Variant
- Trong khi đó hàm Split luôn luôn trả về kết quả là 1 mảng nhưng các phần tử bên trong nó chắc chắn là dạng String. Có thể thử nghiệm chúng minh:

Mã:

MsgBox TypeName(Split("A B C", " "))

Nhận kết quả là String()
Trong khi:

Mã:

MsgBox TypeName(ArrayName)

Ta sẽ nhận kết quả là Variant()
Ví dụ tiếp

Mã:

Sub Arr()
  Dim ArrayName()
  ArrayName = Array("A", "B", "C")
End Sub

Code này không lỗi bởi

Mã:

 MsgBox TypeName(Array("A", "B", "C"))

Sẽ cho kết quả cũng là Variant() tương đồng với kiểu biến của ArrayName
===> Từ đó suy ra: Cho trước 1 mảng có kiểu dữ liệu là A thì bạn chỉ có thể nạp thứ gì đó có kiểu dữ liệu A vào nó mà thôi
Vì lẽ đó mà khi bạn khai báo Dim ArrayName() as String sẽ không lỗi, bởi nó có cùng kiểu dữ liệu với kết quả của hàm Split
Và điều đương nhiên khai báo Dim ArrayName as Variant càng được, bởi khi đó ArrayName có kiểu dữ liệu "rộng" hơn, nó sẽ là bất cứ thứ gì tùy ý (như tôi đã dề cập ở bài trên)

phuyen89 · 23/5/17

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

HieuCD · 23/5/17

phuyen89 đã viết:

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

2 vòng lập lồng với nhau làm khối lượng duyệt qua các dòng rất lớn, bạn tìm hiểu phương thức Find chỉ dùng 1 vòng lập, hoặc Dictionary dùng 2 vòng lập tách rời ra sẽ nhanh hơn nhiều

phuyen89 · 23/5/17

HieuCD đã viết:
2 vòng lập lồng với nhau làm khối lượng duyệt qua các dòng rất lớn, bạn tìm hiểu phương thức Find chỉ dùng 1 vòng lập, hoặc Dictionary dùng 2 vòng lập tách rời ra sẽ nhanh hơn nhiều

PHP:

Sub LookupFunction()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long, rRang As Range
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    Set rRang = Sheets("Data").Range("A5:A5000")

    For i = 1 To k
        If Not rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext) Is Nothing Then
            Cells(i, 3).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 1).Value
            Cells(i, 4).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 2).Value
            Cells(i, 5).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 3).Value
            Cells(i, 6).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 4).Value
            Cells(i, 7).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 5).Value
            Cells(i, 8).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 6).Value
        End If
    Next i
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Anh ơi. Em viết dưới dạng mảng chưa được, Em chưa giải quyết được cấu trúc cú pháp của Find function từ Range sang Array.

PHP:

expression .Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

expression A variable that represents a Range object.

Khi áp dụng vào Array, em thay expression từ range thành biến của Array tương ứng vào range, nhưng vẫn chưa được. Anh gợi ý giúp đỡ.

HieuCD · 23/5/17

find chỉ dùng cho range

Mã:

Option Explicit

Sub VLK()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B1:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  For i = 1 To UBound(sArr1)
    Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    If Not C Is Nothing Then
      firstAddress = C.Address
      Do
        k = C.Row
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j)
        Next j
        Set C = Rng.FindNext(C)
      Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

HieuCD · 23/5/17

phuyen89 đã viết:

PHP:

Sub LookupFunction()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long, rRang As Range
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    Set rRang = Sheets("Data").Range("A5:A5000")

    For i = 1 To k
        If Not rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext) Is Nothing Then
            Cells(i, 3).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 1).Value
            Cells(i, 4).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 2).Value
            Cells(i, 5).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 3).Value
            Cells(i, 6).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 4).Value
            Cells(i, 7).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 5).Value
            Cells(i, 8).Value = rRang.Find(Cells(i, 2).Value, , xlValues, , , xlNext).Offset(0, 6).Value
        End If
    Next i
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Anh ơi. Em viết dưới dạng mảng chưa được, Em chưa giải quyết được cấu trúc cú pháp của Find function từ Range sang Array.

PHP:

expression .Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

expression A variable that represents a Range object.

Khi áp dụng vào Array, em thay expression từ range thành biến của Array tương ứng vào range, nhưng vẫn chưa được. Anh gợi ý giúp đỡ.

bài nầy dùng Dic nhanh hơn nhiều

Mã:

Option Explicit

Sub VLK1()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Tmp
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    sArr2 = .Range("A5:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sArr2)
      .Item(sArr2(i, 1)) = i
    Next i
    For i = 1 To UBound(sArr1)
      Tmp = sArr1(i, 1)
      If .exists(Tmp) Then
        k = .Item(Tmp)
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j + 1)
        Next j
      End If
    Next i
  End With
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

duynguyenhungthinhgia · 26/5/17

Hi mọi người. em là thành viên mới. em có đoạn code mà bị lỗi chỗ: Sheets(Array("A1:B9")).Copy. có bác nào cao thủ chỉ giúp em với
Sub myDim()
Application.ScreenUpdating = False
Dim a(7) As String
With ThisWorkbook
maxrow = .Sheets(1).UsedRange.Rows.Count
For t = 2 To maxrow
For i = 1 To 8
a(i - 1) = Sheets(1).Cells(t, i).Value
Next
If a(0) = "" Then
Exit For
Else
.Sheets(2).Activate
.Sheets(2).Range("B1").Value = a(2)
.Sheets(2).Range("B2").Value = a(3)
.Sheets(2).Range("B3").Value = a(4)
.Sheets(2).Range("B4").Value = a(1)
.Sheets(2).Range("B5").Value = a(0)
.Sheets(2).Range("B6").Value = a(5)
.Sheets(2).Range("B8").Value = a(7)
.Sheets(2).Range("B9").Value = a(6)
Sheets(Array("A1:B9")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & a(7) & a(1) & Format(Date, "yyyy"".""m"".""d"""";@") & ".xls"
ActiveWorkbook.Close
End If
Next
End With
Sheets(1).Activate
Application.ScreenUpdating = True
MsgBox "Íê³É"
End Sub

Ba Tê · 26/5/17

duynguyenhungthinhgia đã viết:
Hi mọi người. em là thành viên mới. em có đoạn code mà bị lỗi chỗ: Sheets(Array("A1:B9")).Copy. có bác nào cao thủ chỉ giúp em với
Sub myDim()
Application.ScreenUpdating = False
Dim a(7) As String
With ThisWorkbook
maxrow = .Sheets(1).UsedRange.Rows.Count
For t = 2 To maxrow
For i = 1 To 8
a(i - 1) = Sheets(1).Cells(t, i).Value
Next
If a(0) = "" Then
Exit For
Else
.Sheets(2).Activate
.Sheets(2).Range("B1").Value = a(2)
.Sheets(2).Range("B2").Value = a(3)
.Sheets(2).Range("B3").Value = a(4)
.Sheets(2).Range("B4").Value = a(1)
.Sheets(2).Range("B5").Value = a(0)
.Sheets(2).Range("B6").Value = a(5)
.Sheets(2).Range("B8").Value = a(7)
.Sheets(2).Range("B9").Value = a(6)
Sheets(Array("A1:B9")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & a(7) & a(1) & Format(Date, "yyyy"".""m"".""d"""";@") & ".xls"
ActiveWorkbook.Close
End If
Next
End With
Sheets(1).Activate
Application.ScreenUpdating = True
MsgBox "Íê³É"
End Sub

Nếu bạn muốn copy vùng A1 B9 của sheet(2) thì thế này

Mã:

.Sheets(2).Range("A1:B9").Copy

tueyennhi · 30/5/17

Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

HieuCD · 30/5/17

tueyennhi đã viết:
Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

bạn làm vấn đề nầy trong những bài tính lương khủng trước đây rồi mà, tạo 2 darr riêng

phuyen89 · 30/5/17

tueyennhi đã viết:
Giả sử em làm việc với mảng như sau
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(i, 2)
dArr(K, 4) = sArr(i, 4)

Sau đó em gán mảng này bắt đầu từ cell A1 Resize sang 4 cột. Về mặt lý thuyết thì:
A tương đương dArr(K,1)
B tương đương dArr(K,2)
D tương đương dArr(K,4)

Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

- Chơi như thế này được không?
range("A1")=darr(k,1)

gán từng dòng trên mảng dArr xuống từng cột trên bảng tính Excel./

VetMini · 30/5/17

tueyennhi đã viết:
Điều em muốn là làm thế nào để cột C không bị tác động bởi dArr(K,3). Nói cách khác mảng sẽ nhảy qua cột C.

1. Copy C sang một mảng khác. Sau khi copy mảng chính thì copy trở lại.
2. Copy dArr xuống 2 cột A và B. Copy dArr(i, 4) sang dArr(i, 1). Copy xuóng cột D

NguyenNgocThuHien · 30/5/17

HieuCD đã viết:

find chỉ dùng cho range

Mã:

Option Explicit

Sub VLK()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B1:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
  For i = 1 To UBound(sArr1)
    Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    If Not C Is Nothing Then
      firstAddress = C.Address
      Do
        k = C.Row
        For j = 1 To 6
          dArr(i, j) = sArr2(k, j)
        Next j
        Set C = Rng.FindNext(C)
      Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Kỳ vậy anh, code gốc chạy trong 0.8s, còn code này chay trong 15s. đã test nhiều lần.

tueyennhi · 30/5/17

Mình có tách như thế này nhưng công nó nhảy không đúng vào ngày, không biết sai ở đâu. Mình cũng chỉ cop nhặt và nhờ sự giúp đỡ của anh em trên này thôi nên có những thứ cơ bản có thể mình vẫn mắc lỗi. Code nằm trong Module Update_cong

tArr(Rws, C) = sArr(i, V1) cái này căn cứ theo C nhưng mà hiện tại nó bị đẩy tiến lên một cột mà mình không biết tại sao.

tueyennhi · 30/5/17

hpkhuong đã viết:
Là sao ? Là sao???

Có nghĩa là cái cột C của bạn có "bí kíp" gì đó hả??? Dán kết quả không muốn đè lên bí kíp này hay sao?

Nếu như tôi hỏi ở trên thì bắt bạn phải đưa cái cột C này vào mảng dArr trong khi code...

Mình nghĩ có khi nào tách ra làm hai mảng giống như HieuCD cũng đã nói ở trên được không. Hiện tại mình tách thì mảng tArr gán không như ý mình mong muốn. Gán từ Range("J8") thì nhảy chuẩn nhưng mình thắc mắc tại sao như vậy nhỉ? Và nếu bắt buộc phải gán như thế thì J8 coi như phải bỏ trống không dùng được ngoài việc để cho việc gán nó chuẩn. Vậy mảng nào gán vào cột bắt nguồn từ J8 này ??

NguyenNgocThuHien · 30/5/17

phuyen89 đã viết:

Em mới học về Array, biến đổi cách dùng hàm Vlookup sang Array.
Các anh góp ý để em thay đổi theo hướng tốt hơn.

PHP:

Sub VLK()
    Application.ScreenUpdating = False
    Dim sArr()
    Dim dArr(1 To 65000, 1 To 6)
    Dim sArr_2()
    Dim i As Long, j As Long, lStart As Double, lFinish As Double, k As Long
    lStart = Timer()
    Sheets("VLK").Range("C1:H65000").ClearContents
    sArr() = Sheets("Data").Range("A5:G65000").Value
    sArr_2 = Sheets("VLK").Range("B1", Range("B65000").End(xlUp)).Value
    k = Sheets("VLK").Range("B65000").End(xlUp).Row
    For i = 1 To k
        For j = 1 To UBound(sArr, 1)
            If sArr_2(i, 1) = sArr(j, 1) Then
                dArr(i, 1) = sArr(j, 2)
                dArr(i, 2) = sArr(j, 3)
                dArr(i, 3) = sArr(j, 4)
                dArr(i, 4) = sArr(j, 5)
                dArr(i, 5) = sArr(j, 6)
                dArr(i, 6) = sArr(j, 7)
                Exit For
            End If
        Next j
    Next i
    Range("C1").Resize(i - 1, 6).Value = dArr
    lFinish = Timer()
    Application.ScreenUpdating = True
   MsgBox "Second: " & (lFinish - lStart), , "Timer"
End Sub

Em cảm thấy vòng lặp For của em, không ổn khi dữ liệu nguồn ngày càng lớn lên.

Mã:

Sub VLK2()
  Application.ScreenUpdating = False
  Dim sArr1(), sArr2(), dArr(), Rng As Range, C As Range, firstAddress
  Dim i As Long, LastR As Long, j As Long, lStart As Double, lFinish As Double, k As Long
  lStart = Timer()
  With Sheets("Data")
    Set Rng = .Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    sArr2 = .Range("B5:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("VLK")
    .Range("C1:H" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    sArr1 = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim dArr(1 To UBound(sArr1), 1 To 6)
 
 
  Dim lIndex As Long
 
  On Error GoTo loitimkiem
 
  For i = 1 To UBound(sArr1)
    'Set C = Rng.Find(sArr1(i, 1), LookIn:=xlValues, Lookat:=xlWhole)
    
  
    lIndex = Application.WorksheetFunction.Match(sArr1(i, 1), Rng, 0)
    
      If lIndex <> 0 Then
            For j = 1 To 6
              dArr(i, j) = sArr2(lIndex, j)
            Next j
        End If
        

    
  Next i
  Sheets("VLK").Range("C1").Resize(UBound(sArr1), 6).Value = dArr
  lFinish = Timer()
  Application.ScreenUpdating = True
  MsgBox "Second: " & (lFinish - lStart), , "Timer"
 
 
 
  Exit Sub
loitimkiem:
    lIndex = 0
    Resume Next
 
End Sub

ndu96081631 · 30/5/17

hpkhuong đã viết:
Nếu như tôi hỏi ở trên thì bắt bạn phải đưa cái cột C này vào mảng dArr trong khi code...

Nếu cột C có công thức thì lại... phiền
Ủng hộ cách dùng 2 mảng riêng, không đụng chạm gì nhau sẽ không.. mích lòng

phuyen89 · 30/5/17

NguyenNgocThuHien đã viết:
Kỳ vậy anh, code gốc chạy trong 0.8s, còn code này chay trong 15s. đã test nhiều lần.

Không biết về đường dài, find có nhanh hơn hay không. Nhưng với dữ liệu hiện tại, thì mảng nhanh hơn đó.

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

Người dùng đang xem chủ đề này

Thành viên gắn bó

Thành viên tích cực

|||||||||||||

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

Chuyên gia GPE

Thành viên mới

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

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

Ăn cùng góc phố

Cute Black Cat

Thành viên tích cực

File đính kèm

Thành viên tích cực

Cute Black Cat

Huyền thoại GPE

Thành viên tích cực

Đếm ngược thời gian