Tập viết code sử dụng mảng. (2 người xem)

[Thuyanhanoi]

- Em đang tập viết code vba sử dụng mảng để lọc danh sách với điều kiện:
+ Tại sheet Danh_sach ở cột TT có ô nào khác rỗng thì lọc qua sheet Loc_danh_sach những ô khác rỗng đó.
+ code em viết chỉ trong trường hợp cột TT này có 1 ô rỗng. Nếu các ô trong cột thứ tự này có 2 ô rỗng liền nhau trở lên hoặc như trong ví dụ thì code không đúng nữa.
- Rất mong được các bác hướng dẫn giúp em!. Cảm ơn các bác nhiều.

 

[thanhlanh]

Ý bạn muốn gì bạn làm thủ công thử xem, chỉ cần ví dụ 10 dòng đầu là được.

 

[concogia]

- Em đang tập viết code vba sử dụng mảng để lọc danh sách với điều kiện:
+ Tại sheet Danh_sach ở cột TT có ô nào khác rỗng thì lọc qua sheet Loc_danh_sach những ô khác rỗng đó.
+ code em viết chỉ trong trường hợp cột TT này có 1 ô rỗng. Nếu các ô trong cột thứ tự này có 2 ô rỗng liền nhau trở lên hoặc như trong ví dụ thì code không đúng nữa.
- Rất mong được các bác hướng dẫn giúp em!. Cảm ơn các bác nhiều.

Khai báo biến: Ok
--Cho biến I chạy từ 1 đến cuối hàng mảng sArr
--Nếu sArr(I,1)<>"" thì
1) Gán biến K= K+1
2) Gán dArr(K,1)= K.
3) Cho biến J chạy từ 2 tới 5, gán từ cột 2 đến 5 của sArr vào cột 2 tới 5 của dArr
4) Cho biến J chạy từ 6 tới 8, gán 3 cột 6, 7, 8 của sArr vào cột 68, 69, 70 của dArr
Vậy là xong mảng dArr, bạn làm tiếp các công đoạn sau ( gán xuống sheet, Sort......)
Chúc thành công
Thân

 

[Thuyanhanoi]

- Cảm ơn Bác Cò.
- Vậy mà em cứ suy nghĩ ngược híc híc

Public Sub Vi_du()Dim I As Long, J As Long, K As Long, sArr(), dArr()
With Sheets("Danh_sach")
sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 70)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 2)
dArr(K, 3) = sArr(I, 3)
dArr(K, 4) = sArr(I, 4)
dArr(K, 5) = sArr(I, 5)
For J = 68 To 70
dArr(K, J) = sArr(I, J - 62)
Next J
End If
Next I
With Sheets("Loc_danh_sach")
.[A10].Resize(K, 70).ClearContents
.[A10].Resize(K, 70).Value = dArr
.[B10].Resize(K, 69).Sort key1:=.[B10]
End With
End Sub

 

[Thuyanhanoi]

Khai báo biến: Ok
--Cho biến I chạy từ 1 đến cuối hàng mảng sArr
--Nếu sArr(I,1)<>"" thì
1) Gán biến K= K+1
2) Gán dArr(K,1)= K.
3) Cho biến J chạy từ 2 tới 5, gán từ cột 2 đến 5 của sArr vào cột 2 tới 5 của dArr
4) Cho biến J chạy từ 6 tới 8, gán 3 cột 6, 7, 8 của sArr vào cột 68, 69, 70 của dArr
Vậy là xong mảng dArr, bạn làm tiếp các công đoạn sau ( gán xuống sheet, Sort......)
Chúc thành công
Thân

Public Sub Vi_du()
Dim I As Long, J As Long, K As Long, sArr(), dArr()
With Sheets("Danh_sach")
sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 70)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
dArr(K, 1) = K
For J = 2 To 5
dArr(K, J) = sArr(I, J)
Next J
For J = 68 To 70
dArr(K, J) = sArr(I, J - 62)
Next J
End If
Next I
With Sheets("Loc_danh_sach")
.[A10].Resize(K, 70).ClearContents
.[A10].Resize(K, 70).Value = dArr
.[B10].Resize(K, 69).Sort key1:=.[B10]
End With
End Sub
- Như thế này có lẽ mới đúng hướng dẫn.

 

[Thuyanhanoi]

Public Sub Vi_du()
Dim I As Long, J As Long, K As Long, sArr(), dArr()
With Sheets("Danh_sach")
sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 70)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
dArr(K, 1) = K
For J = 2 To 5
dArr(K, J) = sArr(I, J)
Next J
For J = 68 To 70
dArr(K, J) = sArr(I, J - 62)
Next J
End If
Next I
With Sheets("Loc_danh_sach")
.[A10].Resize(K, 70).ClearContents
.[A10].Resize(K, 70).Value = dArr
.[B10].Resize(K, 69).Sort key1:=.[B10]
End With
End Sub
- Như thế này có lẽ mới đúng hướng dẫn.

Với code bài trên mọi người cho em hỏi thêm một vấn đề nữa là em muốn sử dụng conditional formatting Từ cột F đến cột BL em thêm dòng lệnh như sau:

.[F10].Resize(K, 59).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
        Formula1:="=4.95", Color:="= 13551615"

Vào code dưới đây:

Public Sub Vi_du()Dim I As Long, J As Long, K As Long, sArr(), dArr()
With Sheets("Danh_sach")
sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 70)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
dArr(K, 1) = K
For J = 2 To 5
dArr(K, J) = sArr(I, J)
Next J
For J = 68 To 70
dArr(K, J) = sArr(I, J - 62)
Next J
End If
Next I
With Sheets("Loc_danh_sach")
.[A10].Resize(K, 70).ClearContents
.[A10].Resize(K, 70).Value = dArr
.[F10].Resize(K, 59).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=4.95", Color:="= 13551615"
.[B10].Resize(K, 69).Sort key1:=.[B10]
End With
End Sub

Mà chưa được. Không hiểu còn thiếu chút gì nữa mong mọi người chỉ giúp.
Cảm ơn mọi người nhiều.

 

[Thuyanhanoi]

Với code bài trên mọi người cho em hỏi thêm một vấn đề nữa là em muốn sử dụng conditional formatting Từ cột F đến cột BL em thêm dòng lệnh như sau:

.[F10].Resize(K, 59).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
        Formula1:="=4.95", Color:="= 13551615"

Vào code dưới đây:

Mà chưa được. Không hiểu còn thiếu chút gì nữa mong mọi người chỉ giúp.
Cảm ơn mọi người nhiều.

Thực hiện Record Macro và ghép lại thì đạt được mục đích đặt ra:

Public Sub Vi_du()Dim I As Long, J As Long, K As Long, sArr(), dArr()With Sheets("Danh_sach")    sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 8).ValueEnd WithReDim dArr(1 To UBound(sArr, 1), 1 To 70)For I = 1 To UBound(sArr, 1)    If sArr(I, 1) <> "" Then        K = K + 1        dArr(K, 1) = K        For J = 2 To 5            dArr(K, J) = sArr(I, J)        Next J        For J = 68 To 70            dArr(K, J) = sArr(I, J - 62)        Next J    End IfNext IWith Sheets("Loc_danh_sach")    .[A10].Resize(K, 70).ClearContents    .[A10].Resize(K, 70).Value = dArr        .[F10].Resize(K, 59).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _        Formula1:="=4.95"    .[F10].Resize(K, 59).FormatConditions(Selection.FormatConditions.Count).SetFirstPriority    With .[F10].Resize(K, 59).FormatConditions(1).Font        .Color = -16383844        .TintAndShade = 0    End With    With .[F10].Resize(K, 59).FormatConditions(1).Interior        .PatternColorIndex = xlAutomatic        .Color = 13551615        .TintAndShade = 0    End With    .[B10].Resize(K, 69).Sort key1:=.[B10]End WithEnd Sub

Nhưng không biết code trên có thể viết gọn lại được nữa không?. Nếu được mong mọi người chỉ giúp. Cảm ơn mọi người.