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ị

dephetnoi · 22/12/17

Em sửa lại cái này nhưng nó chạy bỏ qua 2 dòng không hiểu vì sao ạ?
Sub diennhancong1()
Dim arr()
Dim sarray As Variant
Dim i As Long
Dim j As Long
Range("i8:ae" & Range("kttd1").Row).ClearContents
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
sarray = Range("a8:z" & Range("kttd1").Row - 1).Value
ReDim arr(1 To UBound(sarray), 1 To UBound(sarray, 2))
For i = 1 To UBound(sarray, 1)
For j = 1 To UBound(sarray, 2)
'arr(i, j).ClearContents
If Cells(7, j).Value - Cells(i + 7, 5).Value < 6 And Cells(7, j).Value - Cells(i + 7, 5).Value >= 0 And Cells(i + 7, 1).Value <> "HM" Then
arr(i, j - 8) = "[" & Cells(i + 7, 8) & " NC]"
With arr(i, j).Font
.Name = "Times New Roman"
.Size = 10
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
Range("j8:z" & Range("kttd1").Row - 1).Value = arr()
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

tamtam333 · 22/12/17

dephetnoi đã viết:
Có ai quan tâm bài này nữa không ạ? em đang loay hoay để chuyển cái code sang mảng mà làm mãi không được, code không báo lỗi nhưng lại không giống như cái mà em làm bằng code thường ạ? Bác nào chỉ giúp em với em cũng mới bập bẹ làm quen với VBa thôi ạ

Lập riêng chủ đề đi cho rõ ràng, và cần viết chi tiết - để vào cái chủ đề hũ lút này thì sao mà quan tâm

dephetnoi · 23/12/17

Miình làm được rồi bạn ạ, tốc độ cải thiện lên đáng kể với cùng 1 dữ liệu, cảm ơn các bạn đã quan tâm ạ

tueyennhi · 13/1/18

Cho em hỏi trong mảng khi dùng vòng lặp For (Giả sử For i = 1 to 10). Vậy có cách nào để nếu lỗi thì nó sẽ báo lỗi đang ở i thứ bao nhiêu không? Em dùng lệnh
On Error GoTo Loi
.
.
.
Loi: Msgobx i
Thì không được như mong muốn, nó báo hết Msgbox từ 1 đến 10. Em tưởng khi lỗi nó mới nhảy đến dòng Loi để đưa ra giá trị i chứ nhỉ.

NguyenNgocThuHien · 13/1/18

tueyennhi đã viết:
Cho em hỏi trong mảng khi dùng vòng lặp For (Giả sử For i = 1 to 10). Vậy có cách nào để nếu lỗi thì nó sẽ báo lỗi đang ở i thứ bao nhiêu không? Em dùng lệnh
On Error GoTo Loi
.
.
.
Loi: Msgobx i
Thì không được như mong muốn, nó báo hết Msgbox từ 1 đến 10. Em tưởng khi lỗi nó mới nhảy đến dòng Loi để đưa ra giá trị i chứ nhỉ.

Code đưa thiếu.

on error goto loi

for i.....

next i

exit sub

loi:

msgbox i

Đại loại như vậy.

phuongxd269 · 9/3/18

Mình mới thực hành VBA đc vài hôm thì gặp vấn đề này chắc phải dùng Array và Dictionary. Phần mềm xuất nội lực ra ở nhiều tiết diện trên dầm và ở nhiều tổ hợp khác nhau nhưng mình chỉ muốn lấy 3 giá trị nội lực: 2 giá trị nhỏ nhất ở 2 đầu dầm( giá trị âm lớn nhất), 1 giá trị lớn nhất ở giữa dầm ( giá trị + , không phân biệt vị trí, cứ lớn nhất là lấy). Mình định lọc từng cái 1 để ghép thành mảng hoàn chỉnh xongdùng soft data. Nhưng làm với tiết diện đầu dầm trái thì Code chạy không chuẩn. Mọi người xem dùm lỗi ở đâu! Do bận nên không có nhiều thời gian thực hành nhiều bài nên mong mọi người chỉ giúp! Thank!

themorzer · 5/4/18

code sau dây khi đưa vào list box thì chỉ hiện 1 cột, mình muốn xuất ra theo nhiều cột

Mã:

Function listterminal1(ltArray, ByVal ter As String)
    Dim dic1 As Object, i As Long, j As Long, TmpArr,
    TmpArr = ltArray
Set dic1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(TmpArr)
    If TmpArr(i, 1) = ter Then
        For j = 1 To UBound(TmpArr, 2)
            If TmpArr(i, j) <> Empty Then
          
                dic1.Add TmpArr(i, j), ""
      
            End If
        Next j
    End If
Next i
listterminal1 = dic1.Keys
End Function
[code]
không biết mảng trên có vấn đề j mong mọi người giúp

ndu96081631 · 5/4/18

themorzer đã viết:

code sau dây khi đưa vào list box thì chỉ hiện 1 cột, mình muốn xuất ra theo nhiều cột

Mã:

Function listterminal1(ltArray, ByVal ter As String)
    Dim dic1 As Object, i As Long, j As Long, TmpArr,
    TmpArr = ltArray
Set dic1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(TmpArr)
    If TmpArr(i, 1) = ter Then
        For j = 1 To UBound(TmpArr, 2)
            If TmpArr(i, j) <> Empty Then
         
                dic1.Add TmpArr(i, j), ""
     
            End If
        Next j
    End If
Next i
listterminal1 = dic1.Keys
End Function
[code]
không biết mảng trên có vấn đề j mong mọi người giúp

Nạp dic.keys vào ListBox đương nhiên nó chỉ ra kết quả 1 cột rồi. Muốn nhiều cột phải cho kết quả vào mảng 2 chiều, xong gán mảng 2 chiều ấy vào listBox

themorzer · 5/4/18

ndu96081631 đã viết:
Nạp dic.keys vào ListBox đương nhiên nó chỉ ra kết quả 1 cột rồi. Muốn nhiều cột phải cho kết quả vào mảng 2 chiều, xong gán mảng 2 chiều ấy vào listBox

Do e cứ tưởng chạy 2 vòng lặp là mảng 2 chiều chứ. Vậy mình sử dụng redim hay hàm gì vậy thầy

ndu96081631 · 6/4/18

themorzer đã viết:
Do e cứ tưởng chạy 2 vòng lặp là mảng 2 chiều chứ. Vậy mình sử dụng redim hay hàm gì vậy thầy

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

themorzer · 6/4/18

ndu96081631 đã viết:

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

chương trình của em khi add code này vòa, thì listbox có xuất hiện những dòng rỗng, đã chạy được code, nhưng khi chạy thêm giá trị (click checkbox - giá trị ban dầu không check box thì chạy ok)không có trong mảng thì xuất hiện lỗi

nên em muốn đặt 1 msgbox để link tới Useform nhập liệu

truongvu317 · 6/4/18

themorzer đã viết:
chương trình của em khi add code này vòa, thì listbox có xuất hiện những dòng rỗng, đã chạy được code, nhưng khi chạy thêm giá trị (click checkbox - giá trị ban dầu không check box thì chạy ok)không có trong mảng thì xuất hiện lỗi

nên em muốn đặt 1 msgbox để link tới Useform nhập liệu

ÍT ra cũng phải mô tả qua chức năng của cái form, các control dùng để làm gì, Chụp hình lỗi thì cũng chả chịu kể về việc nó lỗi như thế nào. Xem code chỉ thấy buồn ngủ mới hay chứ.

themorzer · 6/4/18

ndu96081631 đã viết:

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

truongvu317 đã viết:
ÍT ra cũng phải mô tả qua chức năng của cái form, các control dùng để làm gì, Chụp hình lỗi thì cũng chả chịu kể về việc nó lỗi như thế nào. Xem code chỉ thấy buồn ngủ mới hay chứ.

chương trình dò tìm nvl. Phần rẽ Textbox nhập Partcode. Trong listbox sẽ hiện ra giá trị mình muốn tìm. Sau khi chọn xong click vào cbb wire type chọn 1 giá trị và wire size chọn 1 giá trị (2 giá trị này kết hợp lại sẽ là tiêu đề của cột trong sheet terminal.
Trong listbox hiện giá trị sẽ chọn cột 9 và cột này lấy giá trị ứng với các dòng của cột đầu trong sheet terminal
Sau khi chọn xong sẽ được 1 giá trị. Giá trị này tiếp tục đc đo tìm ở sheet5 nhằm lấy partcode, partname, và maker để hiện lên lb_terminal.
Nhưng khi check vô checkbox Sn hoặc au thì xuất hiện lỗi trên. Lỗi trên mình đoán là giá trị sau khi nối thêm chuỗi thi giá trị này k trùng cột partname trong sheet5.
Nên mình muốn tại một msgbox nhằm báo lỗi rỗng để gọi useform nhập liệu lên để nhập vào k cho Thoòng báo lỗi này nữa

themorzer · 6/4/18

themorzer đã viết:
chương trình dò tìm nvl. Phần rẽ Textbox nhập Partcode. Trong listbox sẽ hiện ra giá trị mình muốn tìm. Sau khi chọn xong click vào cbb wire type chọn 1 giá trị và wire size chọn 1 giá trị (2 giá trị này kết hợp lại sẽ là tiêu đề của cột trong sheet terminal.
Trong listbox hiện giá trị sẽ chọn cột 9 và cột này lấy giá trị ứng với các dòng của cột đầu trong sheet terminal
Sau khi chọn xong sẽ được 1 giá trị. Giá trị này tiếp tục đc đo tìm ở sheet5 nhằm lấy partcode, partname, và maker để hiện lên lb_terminal.
Nhưng khi check vô checkbox Sn hoặc au thì xuất hiện lỗi trên. Lỗi trên mình đoán là giá trị sau khi nối thêm chuỗi thi giá trị này k trùng cột partname trong sheet5.
Nên mình muốn tại một msgbox nhằm báo lỗi rỗng để gọi useform nhập liệu lên để nhập vào k cho xảy ra lỗi này

duynguyenkk · 13/4/18

Em có bài toán tổng hợp vật tư theo từng loại dựa vào Đơn vị để tổng hợp từng loại vật tư
Em mới tập tành khai báo như dưới có đúng không

Mã:

Dim n As Long, m As Long
    rng1 as range,rng2 as range, cll1 as range
        Arr As Variant
   
rng1 = .range("K8:K65000").End(xlUp).value
rng2 = .range("O8:O65000") .End(xlUp).value
m = sheet3.Range("K65000").End(xlUp).Row
'Kiem tra du lieu trong sheet "TLuong DT" neu co thi loc
 if m>8 then
            sheet3.select

nhờ các anh chị xem giúp em với

♫ђöล♥ßล†♥†µ♫ · 14/4/18

Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu()
    Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long
    Dim sArr(), tArr(), I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value
Col = 2
ReDim tArr(1 To UBound(sArr), 1 To Col)
ReDim Tam(1 To UBound(sArr), 1 To 1)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2
        Else
            R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1
            If Col < Tam(R, 1) Then
                Col = Tam(R, 1)
                If Col > Columns.Count Then Exit Sub
                ReDim Preserve tArr(1 To UBound(sArr), 1 To Col)
            End If
            tArr(R, Tam(R, 1)) = sArr(I, 2)
        End If
    End If
Next I
Range("J2").Resize(K, UBound(tArr, 2)) = tArr
Set Dic = Nothing
End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

HieuCD · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu() Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long Dim sArr(), tArr(), I As Long, K As Long Set Dic = CreateObject("Scripting.Dictionary") sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value Col = 2 ReDim tArr(1 To UBound(sArr), 1 To Col) ReDim Tam(1 To UBound(sArr), 1 To 1) For I = 1 To UBound(sArr, 1) If sArr(I, 1) <> Empty Then Tem = sArr(I, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2 Else R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1 If Col < Tam(R, 1) Then Col = Tam(R, 1) If Col > Columns.Count Then Exit Sub ReDim Preserve tArr(1 To UBound(sArr), 1 To Col) End If tArr(R, Tam(R, 1)) = sArr(I, 2) End If End If Next I Range("J2").Resize(K, UBound(tArr, 2)) = tArr Set Dic = Nothing End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

Hỏi anh nầy
http://www.giaiphapexcel.com/diendan/threads/bài-10-array.130807/#post-822190

befaint · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ

- Bạn đọc từ bài #847 nhé.
- Khi truyền mảng xuống bảng tính thì cần chú ý tới kích thước của mảng đó so với kích thước của bảng tính.

ndu96081631 · 14/4/18

befaint đã viết:
- Bạn đọc từ bài #847 nhé.
- Khi truyền mảng xuống bảng tính thì cần chú ý tới kích thước của mảng đó so với kích thước của bảng tính.

Vậy cụ thể mình phải sửa sao cho hết lỗi?

truongvu317 · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu() Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long Dim sArr(), tArr(), I As Long, K As Long Set Dic = CreateObject("Scripting.Dictionary") sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value Col = 2 ReDim tArr(1 To UBound(sArr), 1 To Col) ReDim Tam(1 To UBound(sArr), 1 To 1) For I = 1 To UBound(sArr, 1) If sArr(I, 1) <> Empty Then Tem = sArr(I, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2 Else R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1 If Col < Tam(R, 1) Then Col = Tam(R, 1) If Col > Columns.Count Then Exit Sub ReDim Preserve tArr(1 To UBound(sArr), 1 To Col) End If tArr(R, Tam(R, 1)) = sArr(I, 2) End If End If Next I Range("J2").Resize(K, UBound(tArr, 2)) = tArr Set Dic = Nothing End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

Chả hiểu nó là cái giống gì nữa, phải nói yêu cầu người khác mới biết đường mà tìm chứ. Tui chỉ gợi ý cái ReDim Preserve thôi, cái này đại kỵ khi dùng, phải rất thạo mới dúng nhé, mỗi lần redim máy tính nó lại cấp phát bộ nhớ mới, và đống công việc khác sẽ được thực hiện, Preserve thì khỏi phải nói. Nó lại đi copy dữ liệu loạn lện, chốt lại mà nói code chạy chậm ngang rùa bò ( thực tế đã chứng mình cái file này của bạn nó chạy chấm quá trời quá đất)
"Nghẹn ngào tôi nghe như trời đất vỡ
Xót xa phố phường, ôi dâng bao căm hờn "

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

Thành viên gắn bó

Thành viên chính thức

Thành viên mới

Thành viên chính thức

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

Cute Black Cat

Thành viên mới

File đính kèm

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

File đính kèm

Thành viên chính thức

File đính kèm

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

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên tiêu biểu

File đính kèm

Chuyên gia GPE

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

Huyền thoại GPE

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

Đếm ngược thời gian