wuchengcai
Thành viên chính thức
- Tham gia
- 22/6/10
- Bài viết
- 87
- Được thích
- 15
https://giaiphapexcel.com/diendan/threads/cho-mình-hỏi-về-công-thức-đếm-số-dòng.140675/post-905141Mình có Bảng quản lý khách hàng như file đính kèm.
Nhờ các cao thủ GPE giúp đỡ viết code như mô tả trong file nhé.
Mình cần các cao thủ viết code vba giúp, chứ dùng công thức thì mình làm được.
BácMình cần các cao thủ viết code vba giúp, chứ dùng công thức thì mình làm được.
Phần Chart cũng dùng code để lọc dữ liệu luôn.
Cho mình xin lỗi nhé. Mình không đọc kỹ từ ngữ trên diễn đàn.Bác
Ba Tê
Nói ởi đây là bạn không nên dùng từ cao thủ.Ma nên hỏi bình thường thôi.Vì trên này chỉ có người biết với chưa biết thôi bạn à.
Cái biểu đồ mình không biết sử lý.Bạn xem code nhé.Cho mình xin lỗi nhé. Mình không đọc kỹ từ ngữ trên diễn đàn.
Bác nào có thể giúp mình viết các đoạn code như mình mong muốn thì giúp mình nhé.
Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String
With Sheets("KH")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("B3:I" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 6)
End With
With Sheets("Sort")
dk = .Range("b1").Value
For i = 1 To UBound(arr, 1)
If UCase(dk) = UCase(arr(i, 1)) Then
a = a + 1
arr1(a, 1) = a
arr1(a, 2) = arr(i, 1)
arr1(a, 3) = arr(i, 2)
arr1(a, 4) = arr(i, 3)
arr1(a, 5) = arr(i, 6)
arr1(a, 6) = arr(i, 7)
End If
Next i
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A3:F" & lr).ClearContents
If a Then .Range("A3").Resize(a, 6).Value = arr1
End With
End Sub
Sub chuyendulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String
With Sheets("Sort")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("D3:F" & lr).Value
ReDim arr1(1 To 3, 1 To UBound(arr, 1))
For i = 1 To UBound(arr, 1)
a = a + 1
arr1(1, a) = arr(i, 1)
arr1(2, a) = arr(i, 2)
arr1(3, a) = arr(i, 3)
Next i
End With
With Sheets("Chart")
lr = .Cells(3, Columns.Count).End(xlToLeft).Column
If lr > 2 Then .Range("C2:C4").Resize(, lr - 2).ClearContents
If a Then .Range("C2").Resize(3, a).Value = arr1
End With
End Sub
Bạn chỉnh lại giúp khi mình chọn B1 "Sort" thì "Chart" tự động chuyển dữ liệu cột thành dòng luôn, không cần phải ấn vào "KQ" bên "Chart".Cái biểu đồ mình không biết sử lý.Bạn xem code nhé.
Mã:Sub laydulieu() Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String With Sheets("KH") lr = .Range("B" & Rows.Count).End(xlUp).Row If lr < 3 Then Exit Sub arr = .Range("B3:I" & lr).Value ReDim arr1(1 To UBound(arr, 1), 1 To 6) End With With Sheets("Sort") dk = .Range("b1").Value For i = 1 To UBound(arr, 1) If UCase(dk) = UCase(arr(i, 1)) Then a = a + 1 arr1(a, 1) = a arr1(a, 2) = arr(i, 1) arr1(a, 3) = arr(i, 2) arr1(a, 4) = arr(i, 3) arr1(a, 5) = arr(i, 6) arr1(a, 6) = arr(i, 7) End If Next i lr = .Range("B" & Rows.Count).End(xlUp).Row If lr > 2 Then .Range("A3:F" & lr).ClearContents If a Then .Range("A3").Resize(a, 6).Value = arr1 End With End Sub Sub chuyendulieu() Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String With Sheets("Sort") lr = .Range("B" & Rows.Count).End(xlUp).Row If lr < 3 Then Exit Sub arr = .Range("D3:F" & lr).Value ReDim arr1(1 To 3, 1 To UBound(arr, 1)) For i = 1 To UBound(arr, 1) a = a + 1 arr1(1, a) = arr(i, 1) arr1(2, a) = arr(i, 2) arr1(3, a) = arr(i, 3) Next i End With With Sheets("Chart") lr = .Cells(3, Columns.Count).End(xlToLeft).Column If lr > 2 Then .Range("C2:C4").Resize(, lr - 2).ClearContents If a Then .Range("C2").Resize(3, a).Value = arr1 End With End Sub
Bạn chỉnh lại giúp khi mình chọn B1 "Sort" thì "Chart" tự động chuyển dữ liệu cột thành dòng luôn, không cần phải ấn vào "KQ" bên "Chart".
Phần biểu đồ có bạn nào biết cách xử lý không? Giúp mình với.
Đây bạn gộp lại như vậy.Bạn chỉnh lại giúp khi mình chọn B1 "Sort" thì "Chart" tự động chuyển dữ liệu cột thành dòng luôn, không cần phải ấn vào "KQ" bên "Chart".
Phần biểu đồ có bạn nào biết cách xử lý không? Giúp mình với.
Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, arr2
With Sheets("KH")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("B3:I" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 6)
ReDim arr2(1 To 3, 1 To UBound(arr, 1))
End With
With Sheets("Sort")
dk = .Range("b1").Value
For i = 1 To UBound(arr, 1)
If UCase(dk) = UCase(arr(i, 1)) Then
a = a + 1
arr1(a, 1) = a
arr1(a, 2) = arr(i, 1)
arr1(a, 3) = arr(i, 2)
arr1(a, 4) = arr(i, 3)
arr1(a, 5) = arr(i, 6)
arr1(a, 6) = arr(i, 7)
arr2(1, a) = arr1(a, 4)
arr2(2, a) = arr1(a, 5)
arr2(3, a) = arr1(a, 6)
End If
Next i
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A3:F" & lr).ClearContents
If a Then .Range("A3").Resize(a, 6).Value = arr1
End With
With Sheets("Chart")
lr = .Cells(3, Columns.Count).End(xlToLeft).Column
If lr > 2 Then .Range("C2:C4").Resize(, lr - 2).ClearContents
If a Then .Range("C2").Resize(3, a).Value = arr2
End With
End Sub
Khi mình thêm cột Số lượng xe tải ở "KH" thì "Chart" hiện lỗi #N/A, lỗi này là do code hả bạn?Đây bạn gộp lại như vậy.
Mã:Sub laydulieu() Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, arr2 With Sheets("KH") lr = .Range("B" & Rows.Count).End(xlUp).Row If lr < 3 Then Exit Sub arr = .Range("B3:I" & lr).Value ReDim arr1(1 To UBound(arr, 1), 1 To 6) ReDim arr2(1 To 3, 1 To UBound(arr, 1)) End With With Sheets("Sort") dk = .Range("b1").Value For i = 1 To UBound(arr, 1) If UCase(dk) = UCase(arr(i, 1)) Then a = a + 1 arr1(a, 1) = a arr1(a, 2) = arr(i, 1) arr1(a, 3) = arr(i, 2) arr1(a, 4) = arr(i, 3) arr1(a, 5) = arr(i, 6) arr1(a, 6) = arr(i, 7) arr2(1, a) = arr1(a, 4) arr2(2, a) = arr1(a, 5) arr2(3, a) = arr1(a, 6) End If Next i lr = .Range("B" & Rows.Count).End(xlUp).Row If lr > 2 Then .Range("A3:F" & lr).ClearContents If a Then .Range("A3").Resize(a, 6).Value = arr1 End With With Sheets("Chart") lr = .Cells(3, Columns.Count).End(xlToLeft).Column If lr > 2 Then .Range("C2:C4").Resize(, lr - 2).ClearContents If a Then .Range("C2").Resize(3, a).Value = arr2 End With End Sub
Bạn xem lại nhé.Khi mình thêm cột Số lượng xe tải ở "KH" thì "Chart" hiện lỗi #N/A, lỗi này là do code hả bạn?
Giúp mình viết code tự động border A3:G "Sort" khi có dữ liệu luôn nhé (ô trống thì không border).
Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, arr2
With Sheets("KH")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("B3:I" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 7)
ReDim arr2(1 To 4, 1 To UBound(arr, 1))
End With
With Sheets("Sort")
dk = .Range("b1").Value
For i = 1 To UBound(arr, 1)
If UCase(dk) = UCase(arr(i, 1)) Then
a = a + 1
arr1(a, 1) = a
arr1(a, 2) = arr(i, 1)
arr1(a, 3) = arr(i, 2)
arr1(a, 4) = arr(i, 3)
arr1(a, 5) = arr(i, 6)
arr1(a, 6) = arr(i, 7)
arr1(a, 7) = arr(i, 8)
arr2(1, a) = arr1(a, 4)
arr2(2, a) = arr1(a, 5)
arr2(3, a) = arr1(a, 6)
arr2(4, a) = arr1(a, 7)
End If
Next i
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A3:G" & lr).ClearContents
If a Then .Range("A3").Resize(a, 7).Value = arr1
End With
With Sheets("Chart")
lr = .Cells(3, Columns.Count).End(xlToLeft).Column
If lr > 2 Then .Range("C2:C5").Resize(, lr - 2).ClearContents
If a Then .Range("C2").Resize(4, a).Value = arr2
End With
End Sub
Cám ơn bạn nhiều nhé. Phần biểu đồ có ai giúp mình với!Bạn xem lại nhé.
Mã:Sub laydulieu() Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, arr2 With Sheets("KH") lr = .Range("B" & Rows.Count).End(xlUp).Row If lr < 3 Then Exit Sub arr = .Range("B3:I" & lr).Value ReDim arr1(1 To UBound(arr, 1), 1 To 7) ReDim arr2(1 To 4, 1 To UBound(arr, 1)) End With With Sheets("Sort") dk = .Range("b1").Value For i = 1 To UBound(arr, 1) If UCase(dk) = UCase(arr(i, 1)) Then a = a + 1 arr1(a, 1) = a arr1(a, 2) = arr(i, 1) arr1(a, 3) = arr(i, 2) arr1(a, 4) = arr(i, 3) arr1(a, 5) = arr(i, 6) arr1(a, 6) = arr(i, 7) arr1(a, 7) = arr(i, 8) arr2(1, a) = arr1(a, 4) arr2(2, a) = arr1(a, 5) arr2(3, a) = arr1(a, 6) arr2(4, a) = arr1(a, 7) End If Next i lr = .Range("B" & Rows.Count).End(xlUp).Row If lr > 2 Then .Range("A3:G" & lr).ClearContents If a Then .Range("A3").Resize(a, 7).Value = arr1 End With With Sheets("Chart") lr = .Cells(3, Columns.Count).End(xlToLeft).Column If lr > 2 Then .Range("C2:C5").Resize(, lr - 2).ClearContents If a Then .Range("C2").Resize(4, a).Value = arr2 End With End Sub
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2