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

[viehoai]

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ị

 

[tueyennhi]

  Set uv = Range("C9:C5000").FormatConditions.AddUniqueValues
  uv.DupeUnique = xlDuplicate
  uv.Interior.Color = vbYellow

Code trên dùng để đổ màu vàng với các giá trị trùng lặp, vậy có cách nào thay vì đổ màu vàng thì nếu phát hiện giá trị trùng nhau thì tại cột A của dòng đó đổ giá trị là 2 không anh chị? Hiện tại em đang dùng countif để đếm giá trị trùng lặp sau đó gán mảng đó vào cột A nhưng mà chậm quá.

 

[ndu96081631]

  Set uv = Range("C9:C5000").FormatConditions.AddUniqueValues
  uv.DupeUnique = xlDuplicate
  uv.Interior.Color = vbYellow

Code trên dùng để đổ màu vàng với các giá trị trùng lặp, vậy có cách nào thay vì đổ màu vàng thì nếu phát hiện giá trị trùng nhau thì tại cột A của dòng đó đổ giá trị là 2 không anh chị?

Chắc là không có cách!

 

[tueyennhi]

Chắc là không có cách!

Vâng em cảm ơn thầy!. Vậy có cách nào khác tối ưu hơn so với dùng hàm countif không ạ?

Ngoài ra em đang tập viết code về mảng mà đang mắc ở đây:

    sArray = Sheets("Check").Range("A1").Resize(22, 31).Value
    ReDim dArr(1 To 30, 1 To 30)
    k = 0
    For j = 1 To 32
        If ActiveSheet.Name = sArray(1, j).Value Then
            For i = 1 To 22
                If sArray(i, j) = 0 Then
                    k = k + 1
                    dArr(k, 1) = sArray(i, 1)
                End If
            Next i
        End If
    Next j
  
    [D13].Resize(k, 1) = dArr

Code này có gì sai mà toàn báo lỗi ở dòng If ActiveSheet.Name = sArray(1, j).Value Then ?

Với cả code đang tạo mảng 1 chiều (em cứ gọi là mảng dọc) thì gán thành mảng ngang như nào vậy thầy?

 

[befaint]

Code này có gì sai mà toàn báo lỗi ở dòng If ActiveSheet.Name = sArray(1, j).Value Then

For j = 1 To 32
trong khi ubound(sArray,2)=31 --> sArray(1,32)?

Mảng thì không có thuộc tính .Value: sArray(1, j).Value

Với cả code đang tạo mảng 1 chiều (em cứ gọi là mảng dọc) thì gán thành mảng ngang như nào

Giả sử có mảng một chiều:
mang1c=array(1,2,3,4) có số phần tử n = ubound(mang1c)-lbound(mang1c)+1
Khởi tạo mảng 2 chiều:
Dim mang2c(1 to n, 0) 'Mảng 2 chiều có n hàng, 1 cột) (1)
'Hoặc Dim mang2c(0, 1 to n) 'Mảng 2 chiều có 1 dòng, n cột) (2)
Khai báo biến chạy:
Dim i as long, j as long
Vòng lặp chuyển phần tử mang1c sang mang2c:

For i=lbuound(mang1c) to ubound(mang1c)
j=j+1
'(1):
mang2c(j,0)=mang1c(i)
'(2):
'mang2c(0,j)=mang1c(i)
next i

 

[tueyennhi]

For j = 1 To 32
trong khi ubound(sArray,2)=31 --> sArray(1,32)?


Giả sử có mảng một chiều:
mang1c=array(1,2,3,4) có số phần tử n = ubound(mang1c)-lbound(mang1c)+1
Khởi tạo mảng 2 chiều:
Dim mang2c(1 to n, 0) 'Mảng 2 chiều có n hàng, 1 cột) (1)
'Hoặc Dim mang2c(0, 1 to n) 'Mảng 2 chiều có 1 dòng, n cột) (2)
Khai báo biến chạy:
Dim i as long, j as long
Vòng lặp chuyển phần tử mang1c sang mang2c:

For i=lbuound(mang1c) to ubound(mang1c)
j=j+1
'(1):
mang2c(j,0)=mang1c(i)
'(2):
'mang2c(0,j)=mang1c(i)
next i

Befaint ơi mình đã sửa 32 thành 31 rồi mà vẫn báo lỗi ở dòng lệnh Activesheet.Name. (Mặc dù dòng 1 kéo dài từ cột 1 đến cột 32 có giá trị là tên sheet hiện hành). Lạ quá

 

[befaint]

Befaint ơi mình đã sửa 32 thành 31 rồi mà vẫn báo lỗi ở dòng lệnh Activesheet.Name. (Mặc dù dòng 1 kéo dài từ cột 1 đến cột 32 có giá trị là tên sheet hiện hành). Lạ quá

So sánh chuỗi trong VBA thì dùng Like
ví dụ:

vba.ucase(activesheet.name) like vba.ucase(sArray(1, j).Value)

 

[tueyennhi]

Mình thêm lệnh On Error Resume Next thì không lỗi nữa

    sArray = Sheets("Check").Range("A1").Resize(22, 31).Value
    ReDim dArr(1 To 31, 1 To 31)
    On Error Resume Next
    k = 0
    For j = 1 To 31
        If ActiveSheet.Name = sArray(1, j).Value Then
            For i = 2 To 22
                If sArray(i, j) = 0 Then
                    k = k + 1
                    dArr(k, 1) = sArray(i, 1)
                End If
            Next i
        End If
    Next j
 
    [D13].Resize(k, 1) = dArr

Tuy nhiên mảng khi gán có 31 giá trị đúng và thừa 130 giá trị #N/A không biết ở đâu ra.

Còn thay vì gán dọc mình chuyển gán ngang bằng cái này, cách của befaint mình sẽ học hỏi thêm.

[D13].Resize(1, k) = WorksheetFunction.Transpose(dArr)

 

[befaint]

Mình thêm lệnh On Error Resume Next thì không lỗi nữa

Dịch câu đó nghĩa là gì? Đang tìm và xử lý lỗi thì sao lại bỏ qua? Làm sao biết kết quả đúng hay sai?

For i = 2 To 22
 k = k + 1
dArr(k, 1) = sArray(i, 1)

Kết quả cần trả về là 1 cột, có tối đa 22-2+1=21 dòng thì sao lại có ReDim dArr(1 To 31, 1 To 31)??
Redim dArr(1 to 21, 1 to 1)

Trước khi gán kết quả cần kiểm ta có gì để gán không đã:
if k>0 then [D13].Resize(k, 1) = dArr

Để giảm số lần xét, giả sử không cần chạy hết vòng lặp đã thỏa điều kiện thì nên thoát vòng lặp:

For j = 1 To 31
        If vba.ucase(activesheet.name) like vba.ucase(sArray(1, j).Value) Then
            For i = 2 To 22
'...
            Next i
        Exit for
        End If
Next j

[D13].Resize(1, k) = WorksheetFunction.Transpose(dArr)
Cái này có thể gặp lỗi, chịu khó tìm đọc trên diễn đàn.
Gán xuống 1 hàng thì tạo sao không làm vậy: Redim dArr(1 to 1, 1 to 21)

 

[tueyennhi]

Bạn xem file giúp mình nhé, hoa mắt rồi (. Mục đích của mình là tại sheet có tên 19 mình sẽ lấy cột có giá trị 19 ở sheet Check. Tiếp tục kiểm tra ở cột đó từ dòng 1 đến 22 nếu dòng nào có giá trị 0 thì lấy giá trị dòng đó tại cột A.

 

[befaint]

Bạn xem file giúp mình nhé, hoa mắt rồi (. Mục đích của mình là tại sheet có tên 19 mình sẽ lấy cột có giá trị 19 ở sheet Check. Tiếp tục kiểm tra ở cột đó từ dòng 1 đến 22 nếu dòng nào có giá trị 0 thì lấy giá trị dòng đó tại cột A.

Sub hochoi()
Dim mangDL(), i As Integer, j As Integer, k As Integer
Dim maxRow As Long, maxCol As Long
mangDL = Sheets("Check").Range("A1").Resize(22, 31).Value
maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
ReDim KQngang(0, 1 To maxRow)
ReDim KQdoc(1 To maxRow, 0)
For j = 1 To maxCol
    If ActiveSheet.Name Like mangDL(1, j) Then
        For i = 1 To maxRow 
            If mangDL(i, j) = 0 Then
                k = k + 1
                KQngang(0, k) = mangDL(i, 1)
                KQdoc(k, 0) = mangDL(i, 1)
            End If
        Next i
        Exit For
    End If
Next j
If k Then ActiveSheet.Range("A1").Resize(k, 1) = KQdoc
If k Then ActiveSheet.Range("A1").Resize(1, k) = KQngang
End Sub

 

[tueyennhi]

Sub hochoi()
Dim mangDL(), i As Integer, j As Integer, k As Integer
Dim maxRow As Long, maxCol As Long
mangDL = Sheets("Check").Range("A1").Resize(22, 31).Value
maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
ReDim KQngang(0, 1 To maxRow)
ReDim KQdoc(1 To maxRow, 0)
For j = 1 To maxCol
    If ActiveSheet.Name Like mangDL(1, j) Then
        For i = 1 To maxRow
            If mangDL(i, j) = 0 Then
                k = k + 1
                KQngang(0, k) = mangDL(i, 1)
                KQdoc(k, 0) = mangDL(i, 1)
            End If
        Next i
        Exit For
    End If
Next j
If k Then ActiveSheet.Range("A1").Resize(k, 1) = KQdoc
If k Then ActiveSheet.Range("A1").Resize(1, k) = KQngang
End Sub

Cảm ơn befaint nhé, bài này mình học được nhiều kiến thức hay rồi

 

[tueyennhi]

Cho em hỏi về in có điều kiện như sau:

Sub In_loc()
Dim MangIn as Variant
Dim I As Integer, Row As Integer

Row = Range("A65536").End(xlUp).Row
MangIn = Range("A1").Resize(Row, 16).Value
    For I = 1 To Row
        MangIn.AutoFilter Field:=16, Criteria1:=I
    Next I

End Sub

Có phải Autofilter không nhận mảng mà em làm toàn báo lỗi? Và sau mỗi vòng lặp lọc tự động in thì em thêm câu lệnh nào nữa?

 

[befaint]

Cho em hỏi về in có điều kiện như sau:

Sub In_loc()
Dim MangIn as Variant
Dim I As Integer, Row As Integer

Row = Range("A65536").End(xlUp).Row
MangIn = Range("A1").Resize(Row, 16).Value
    For I = 1 To Row
        MangIn.AutoFilter Field:=16, Criteria1:=I
    Next I

End Sub

Có phải Autofilter không nhận mảng mà em làm toàn báo lỗi? Và sau mỗi vòng lặp lọc tự động in thì em thêm câu lệnh nào nữa?

Thông thường để in hàng loạt, người ta thiết kế 1 sheet làm Form để in (chứ không dùng cách filter ở bảng dữ liệu rồi in).

http://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-từ-file-excel-vào-word.121498/#post-761300
http://www.giaiphapexcel.com/dienda...excel-từ-bảng-lương-excel.125319/#post-785780

 

[tueyennhi]

Với một bài về mảng gần tương tự bài trước mình gửi mà không biết vì sao code nó không chạy ra kết quả mong muốn. Mọi người giúp mình nhé.

 

[phuyen89]

Cho em hỏi về in có điều kiện như sau:

Sub In_loc()
Dim MangIn as Variant
Dim I As Integer, Row As Integer

Row = Range("A65536").End(xlUp).Row
MangIn = Range("A1").Resize(Row, 16).Value
    For I = 1 To Row
        MangIn.AutoFilter Field:=16, Criteria1:=I
    Next I

End Sub

Có phải Autofilter không nhận mảng mà em làm toàn báo lỗi? Và sau mỗi vòng lặp lọc tự động in thì em thêm câu lệnh nào nữa?

- Phương thức của Autofilter chi đi với đối tượng Range thôi.
- Nếu bạn đã dùng Mảng rồi, thì chơi Mảng luôn, không cần đụng tới Phương thức Autofilter nữa.

 

[tueyennhi]

Với bài #874 thì code sau cho kết quả vẫn chưa như mong muốn. Tự làm từ A đến Z oải thật.

Sub hochoi2()
Dim mangDL(), i As Integer, j As Integer, k As Integer, l As Long
Dim maxRow As Long, maxCol As Long

With Sheets("Check")
mangDL = .Range("A1").Resize(22, 31).Value
maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
k = 0

ReDim KQ(1 To maxRow, 1 To maxCol)
    For i = 2 To maxRow
        For j = 2 To maxCol
            If mangDL(i, j) > 400 Then
                k = k + 1
                KQ(k, 1) = mangDL(i, 1)
                KQ(k, j) = mangDL(i, j)
            End If
        Next j
    Next i
MsgBox k

If k Then
Sheets("19").Range("A9").Resize(k, j) = KQ
End If

End With
End Sub

 

[phuyen89]

Với một bài về mảng gần tương tự bài trước mình gửi mà không biết vì sao code nó không chạy ra kết quả mong muốn. Mọi người giúp mình nhé.

Sub hochoi2()
Dim mangDL(), i As Integer, j As Integer, k As Integer
Dim maxRow As Long, maxCol As Long

With Sheets("Check")
    mangDL = .Range("B2").Resize(21, 31).Value
    maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
ReDim KQ(1 To maxRow, 1 To maxCol)
    For i = 1 To maxRow
        For j = 1 To maxCol
            If mangDL(i, j) > 400 Then
                KQ(i, j) = mangDL(i, j)
            End If
        Next j
    Next i
    Sheets("19").Range("B9").Resize(maxRow, maxCol) = KQ
End With

End Sub

 

[tueyennhi]

Sub hochoi2()
Dim mangDL(), i As Integer, j As Integer, k As Integer
Dim maxRow As Long, maxCol As Long

With Sheets("Check")
    mangDL = .Range("A1").Resize(22, 31).Value
    maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
k = 0

ReDim KQ(1 To maxRow, 1 To maxCol)
    For i = 1 To maxRow
        For j = 1 To maxCol
            If mangDL(i, j) > 400 Then
                KQ(i, j) = mangDL(i, j)
            End If
        Next j
    Next i

If k Then

    Sheets("19").Range("A9").Resize(22, 31) = KQ

End If

End With

End Sub

Bởi vì không đặt biến k cho nên kết quả chỉ loại bỏ giá trị ở các cột không thỏa mãn, mình muốn bỏ hẳn các STT không đạt yêu cầu thì không cho vào mảng .

 

[phuyen89]

Sub hochoi2()
Dim mangDL(), i As Integer, j As Integer, k As Integer
Dim maxRow As Long, maxCol As Long

With Sheets("Check")
    mangDL = .Range("B2").Resize(21, 31).Value
    maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
ReDim KQ(1 To maxRow, 1 To maxCol)
    For i = 1 To maxRow
        For j = 1 To maxCol
            If mangDL(i, j) > 400 Then
                KQ(i, j) = mangDL(i, j)
            End If
        Next j
    Next i
    Sheets("19").Range("B9").Resize(maxRow, maxCol) = KQ
End With

End Sub

Bạn tiến hành duyệt 1 lần nữa, xóa các dòng trống đi, nữa là xong.

 

[tueyennhi]

Bạn tiến hành duyệt 1 lần nữa, xóa các dòng trống đi, nữa là xong.

Ừm cảm ơn bạn, để mình ngâm cứu thêm