Em cần giúp đỡ về VBA hàm Sum ạ

[KhoiLe12]

Em chào anh chị, em có một thắc mắc muốn hỏi. Ở trong file em đính kèm ở dưới, từ bảng data ban đầu ở trên em đang muốn tạo ra được bảng ở dưới bằng VBA. Logic của em là bỏ qua cột đầu tiên (vì đó là tên của các SKU), sau đó cứ xét mỗi 2 cột tiếp theo (dùng vòng lặp) và cộng lại để ra cột mới cho đến khi gặp cột cuối cùng (là cột "Tổng") thì sẽ dừng lại. Lý do em muốn xài loop VBA mà không cộng sum bằng tay là bởi có thể trong tương lai còn thêm nhiều cột data nữa nên em mới mong muốn được sử dụng VBA ạ.

Dạ với lại em cũng muốn trong đoạn code VBA đó có thể xuất ra được label của cột đầu tiên trong 2 cột ( ví dụ 2 cột THỨ 7 và KM T7) thì em muốn tên của cột sau khi tính tổng sẽ là THỨ 7 ạ

Em cảm ơn anh chị đã đọc bài viết. Chúc anh chị một ngày tốt lành ạ.

 

[Nhattanktnn]

từ bảng data ban đầu ở trên em đang muốn tạo ra được bảng ở dưới

Mình vẫn chưa biết bảng đầu là bảng nào và bảng dưới là bảng nào

 

[Maika8008]

Mình vẫn chưa biết bảng đầu là bảng nào và bảng dưới là bảng nào

Bảng dưới là bảng tàng hình, cần có vê bê a mới thấy được , nhưng thớt lại đăng trong Hàm và công thức nên bảng dưới chắc lâu hiện hình

 

[KhoiLe12]

Úi em đính nhầm file, ae xem lại giúp em nhe

Mình vẫn chưa biết bảng đầu là bảng nào và bảng dưới là bảng nào

 

[BuiQuangThuan]

Úi em đính nhầm file, ae xem lại giúp em nhe

Các dòng có SKU lặp lại trùng nhau không?

 

[SA_DQ]

Bạn thử kiểm theo macro sau:

Sub Sum2Columns()
 Dim lRow As Long, lCol As Integer, J As Long, Cot As Integer
    
 lRow = Cells(Rows.Count, "B").End(xlUp).Row     'Get the last row in column A  '
 lCol = [d2].CurrentRegion.Columns.Count
 ReDim Arr(1 To lRow, 1 To lCol)
 For J = 2 To lRow
    Arr(1, 1) = Cells(1, "A").Value
    Arr(J, 1) = Cells(J, 1).Value
    For Cot = 2 To lCol - 1 Step 2
        If Arr(1, 1 + Cot / 2) = "" Then _
            Arr(1, 1 + Cot / 2) = Cells(1, Cot).Value
        Arr(J, 1 + Cot / 2) = Cells(J, Cot).Value + Cells(J, Cot + 1).Value
    Next Cot
 Next J
 [P1].Resize(J, 1 + lCol / 2).Value = Arr()
End Sub

 

[KhoiLe12]

Các dòng có SKU lặp lại trùng nhau không?

Dạ không có trùng anh ơii

Bài đã được tự động gộp: 20/6/23

Bạn thử kiểm theo macro sau:

Sub Sum2Columns()
 Dim lRow As Long, lCol As Integer, J As Long, Cot As Integer
   
 lRow = Cells(Rows.Count, "B").End(xlUp).Row     'Get the last row in column A  '
 lCol = [d2].CurrentRegion.Columns.Count
 ReDim Arr(1 To lRow, 1 To lCol)
 For J = 2 To lRow
    Arr(1, 1) = Cells(1, "A").Value
    Arr(J, 1) = Cells(J, 1).Value
    For Cot = 2 To lCol - 1 Step 2
        If Arr(1, 1 + Cot / 2) = "" Then _
            Arr(1, 1 + Cot / 2) = Cells(1, Cot).Value
        Arr(J, 1 + Cot / 2) = Cells(J, Cot).Value + Cells(J, Cot + 1).Value
    Next Cot
 Next J
 [P1].Resize(J, 1 + lCol / 2).Value = Arr()
End Sub

Em cảm ơn anh nhiều ạ, macro chạy ngon rùi anh ơi

 

[KhoiLe12]

Bạn thử kiểm theo macro sau:

Sub Sum2Columns()
 Dim lRow As Long, lCol As Integer, J As Long, Cot As Integer
  
 lRow = Cells(Rows.Count, "B").End(xlUp).Row     'Get the last row in column A  '
 lCol = [d2].CurrentRegion.Columns.Count
 ReDim Arr(1 To lRow, 1 To lCol)
 For J = 2 To lRow
    Arr(1, 1) = Cells(1, "A").Value
    Arr(J, 1) = Cells(J, 1).Value
    For Cot = 2 To lCol - 1 Step 2
        If Arr(1, 1 + Cot / 2) = "" Then _
            Arr(1, 1 + Cot / 2) = Cells(1, Cot).Value
        Arr(J, 1 + Cot / 2) = Cells(J, Cot).Value + Cells(J, Cot + 1).Value
    Next Cot
 Next J
 [P1].Resize(J, 1 + lCol / 2).Value = Arr()
End Sub

Dạ anh ơi cho em hỏi thêm chút, trong trường hợp dataset của em có thêm 1 cột số thứ tự ở cột A (tức là data bị dịch sang bên phải 1 cột, còn hàng thì vẫn giữ nguyên) thì mình chỉnh sửa như thế nào để khi ra kết quả sẽ kèm theo cột số thứ tự anh ạ. Em cảm ơn anh nha

 

[bebo021999]

Xài đỡ code này nhé bạn:

Option Explicit
Sub tonghop()
Dim lr&, i&, j&, k&, rng, res
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A1:N" & lr).Value
res = Range("A1:H" & lr).Value
For i = 1 To UBound(rng)
    k = 2
    For j = 3 To UBound(rng, 2) Step 2
        k = k + 1
        If i = 1 Then
            res(1, k) = rng(1, j)
        Else
            res(i, k) = rng(i, j) + rng(i, j + 1)
        End If
    Next
Next
With Range("Q1")
    .Resize(100000, UBound(res, 2)).ClearContents
    .Resize(UBound(res), UBound(res, 2)).Value = res
End With
End Sub

 

[KhoiLe12]

Xài đỡ code này nhé bạn:

Option Explicit
Sub tonghop()
Dim lr&, i&, j&, k&, rng, res
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A1:N" & lr).Value
res = Range("A1:H" & lr).Value
For i = 1 To UBound(rng)
    k = 2
    For j = 3 To UBound(rng, 2) Step 2
        k = k + 1
        If i = 1 Then
            res(1, k) = rng(1, j)
        Else
            res(i, k) = rng(i, j) + rng(i, j + 1)
        End If
    Next
Next
With Range("Q1")
    .Resize(100000, UBound(res, 2)).ClearContents
    .Resize(UBound(res), UBound(res, 2)).Value = res
End With
End Sub

Dạ đúng cái em đang cần rùi, em cảm ơn anh nhiều lắm ạ.