Copy từ sheet 1 qua sheet 2 theo cột chỉ định

wuchengcai · 16/2/19

Mì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é.

Ba Tê · 17/2/19

wuchengcai đã viết:
Mì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é.

https://giaiphapexcel.com/diendan/threads/cho-mình-hỏi-về-công-thức-đếm-số-dòng.140675/post-905141

wuchengcai · 18/2/19

Ba Tê đã viết:
https://giaiphapexcel.com/diendan/threads/cho-mình-hỏi-về-công-thức-đếm-số-dòng.140675/post-905141

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.
Phần Chart cũng dùng code để lọc dữ liệu luôn.

snow25 · 18/2/19

wuchengcai đã viết:
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.
Phần Chart cũng dùng code để lọc dữ liệu luôn.

Bác
Ba Tê
Nói ởi đây là bạn không nên dùng từ cao thủ.Mà 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 à.

wuchengcai · 18/2/19

snow25 đã viết:
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 à.

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é.

snow25 · 18/2/19

wuchengcai đã viết:
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é.

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

wuchengcai · 18/2/19

snow25 đã viết:

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.

snow25 · 18/2/19

wuchengcai đã viết:
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.

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

wuchengcai · 18/2/19

snow25 đã viết:

Đâ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

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).

snow25 · 18/2/19

wuchengcai đã viết:
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).

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

wuchengcai · 1/3/19

snow25 đã viết:

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

Cám ơn bạn nhiều nhé. Phần biểu đồ có ai giúp mình với!

Copy từ sheet 1 qua sheet 2 theo cột chỉ định

wuchengcai

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

File đính kèm

Ba Tê

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

wuchengcai

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

snow25

Thành viên gạo cội

wuchengcai

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

snow25

Thành viên gạo cội

File đính kèm

wuchengcai

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

File đính kèm

snow25

Thành viên gạo cội

File đính kèm

wuchengcai

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

File đính kèm

snow25

Thành viên gạo cội

wuchengcai

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

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng