[Giúp] VBA nối lần lượt các Range (1 người xem)

[ngoctuyen1995]

Chào cả nhà GPEX!

Mong cả nhà giúp em hoàn thành dự án dưới ạ..
Hiện tại em có



Công việc:
- Tại cột E = A2 "nối với" D2 "nối với" B2 "nối với" D2 "nối với "C2. Và lần lượt A2 "nối với" D2 "nối với" B3 "nối với" D2 "nối với C3"........ cho tới hết cột B và C .. và bắt đầu lại cột A3 nối lần lượt giống như A2..

Mong các Thầy giúp đỡ ạ.!

 

[phulien1902]

Chào cả nhà GPEX!

Mong cả nhà giúp em hoàn thành dự án dưới ạ..
Hiện tại em có

View attachment 176646

Công việc:
- Tại cột E = A2 "nối với" D2 "nối với" B2 "nối với" D2 "nối với "C2. Và lần lượt A2 "nối với" D2 "nối với" B3 "nối với" D2 "nối với C3"........ cho tới hết cột B và C .. và bắt đầu lại cột A3 nối lần lượt giống như A2..

Mong các Thầy giúp đỡ ạ.!

------------------------

 

[ngoctuyen1995]

Sub XYZ()
Dim sArr, dArr(1 To 10000, 1 To 1), i As Long, K As Long, J As Long
sArr = Range("A2:C13").Value
For i = 1 To UBound(sArr)
    For J = i To UBound(sArr)
        K = K + 1
        dArr(K, 1) = sArr(i, 1) & "+" & sArr(J, 2) & "+" & sArr(J, 3)
    Next
Next
    If K Then Range("F2").Resize(K).Value = dArr
End Sub

Cảm ơn Thầy đã giúp đỡ em ạ!

Mới đầu thì chạy đúng ý em, nhưng khi em xóa một dòng ở bất kỳ hàng nào thì nó lại chạy ra sai ạ.. Lý do nó cộng thêm ô bị lank ạ..

em gửi file thực tế của em Thầy giúp em nhé!

 

[ngoctuyen1995]

------------------------

Cảm ơn Thầy đã giúp đỡ ạ..
Ý của em không phải vậy ạ... Cột A2 sẽ nối lần lượt đến hết cột B và cột C, nối xong thì tiếp tục cột A3 sẽ nối lần lượt đến hết cột B và cột C và cứ thế cho hết dãy A ạ.!

File thực tế của em ạ.!

 

[ngoctuyen1995]

Sub XYZ()
Dim sArr, dArr(1 To 10000, 1 To 1), i As Long, K As Long, J As Long
sArr = Range("A2", Range("A65000").End(3)).Resize(, 3).Value
For i = 1 To UBound(sArr)
If Len(sArr(i, 1)) Then
    For J = i To UBound(sArr)
        K = K + 1
        dArr(K, 1) = sArr(i, 1) & "+" & sArr(J, 2) & "+" & sArr(J, 3)
    Next
End If
Next
    If K Then Range("F2").Resize(K).Value = dArr
End Sub

Chào Thầy!

Từ O1 thì chạy đúng rồi ạ, nhưng tới O2 thì bị thiếu 1 giá trị, O3 thì thiếu 2 giá trị.....O12 thiếu 11 giá trị...

 

[VetMini]

Chào Thầy!

Từ O1 thì chạy đúng rồi ạ, nhưng tới O2 thì bị thiếu 1 giá trị, O3 thì thiếu 2 giá trị.....O12 thiếu 11 giá trị...

Toi biết thể nào cũng thiếu cho nên không buòn trả lời.
Cho biết O2 đúng thì ra sao, O3 đúng thì ra sao, và O12 đúng ra sao.

Loại câu hỏi này ít nhất phải chỉnh sửa 3 lần.

 

[ngoctuyen1995]

Toi biết thể nào cũng thiếu cho nên không buòn trả lời.
Cho biết O2 đúng thì ra sao, O3 đúng thì ra sao, và O12 đúng ra sao.

Loại câu hỏi này ít nhất phải chỉnh sửa 3 lần.

Em cảm ơn Thầy đã quan tâm ạ...
Thầy xem file đính kèm của em nhé... Trong file em có làm tay đó là kết quả cuối cùng ạ..
Xin lỗi vì đã làm phiền Thầy ạ.. Mong Thầy giúp đỡ em!

 

[VetMini]

Bạn mới tốt nghiệp mẫu giáo kia ơi. Có đầy đủ yêu cầu rồi, ra tay cho người đẹp đi.

 

[Ba Tê]

Công việc:
- Tại cột E = A2 "nối với" D2 "nối với" B2 "nối với" D2 "nối với "C2. Và lần lượt A2 "nối với" D2 "nối với" B3 "nối với" D2 "nối với C3"........ cho tới hết cột B và C .. và bắt đầu lại cột A3 nối lần lượt giống như A2..

Cảm ơn Thầy đã giúp đỡ ạ..
Ý của em không phải vậy ạ... Cột A2 sẽ nối lần lượt đến hết cột B và cột C, nối xong thì tiếp tục cột A3 sẽ nối lần lượt đến hết cột B và cột C và cứ thế cho hết dãy A ạ.!

Em cảm ơn Thầy đã quan tâm ạ...
Thầy xem file đính kèm của em nhé... Trong file em có làm tay đó là kết quả cuối cùng ạ..
Xin lỗi vì đã làm phiền Thầy ạ.. Mong Thầy giúp đỡ em!

Quá nhiều lần giải thích mà chẳng ai hiểu.
Đến kết quả mẫu cũng không đúng "quy luật".
O1+A+B
O1+A+B1
O1+A+B10
O1+A+B11
...........
Kết quả cột C lấy B1 rồi đến B10 ?
Là sao ta. Híc!

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, R As Long, Str As String
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 3).Value2
R = UBound(sArr): Str = Range("D2").Value2
ReDim dArr(1 To R ^ 3, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        For J = 1 To R
            If sArr(J, 2) <> "" Then
                For N = 1 To R
                    If sArr(N, 3) <> "" Then
                        K = K + 1
                        dArr(K, 1) = sArr(I, 1) & Str & sArr(J, 2) & Str & sArr(N, 3)
                    End If
                Next N
            End If
        Next J
    End If
Next I
Range("F2").Resize(K) = dArr
End Sub

 

[concogia]

Quá nhiều lần giải thích mà chẳng ai hiểu.
Đến kết quả mẫu cũng không đúng "quy luật".
O1+A+B
O1+A+B1
O1+A+B10
O1+A+B11
...........
Kết quả cột C lấy B1 rồi đến B10 ?
Là sao ta. Híc!

Muốn kết "wả" như bạn í thì Sort các cột trước khi chạy 3 vòng lặp là ra thôi mà
Hên thì trúng
Híc

 

[ngoctuyen1995]

Quá nhiều lần giải thích mà chẳng ai hiểu.
Đến kết quả mẫu cũng không đúng "quy luật".
O1+A+B
O1+A+B1
O1+A+B10
O1+A+B11
...........
Kết quả cột C lấy B1 rồi đến B10 ?
Là sao ta. Híc!

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, R As Long, Str As String
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 3).Value2
R = UBound(sArr): Str = Range("D2").Value2
ReDim dArr(1 To R ^ 3, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        For J = 1 To R
            If sArr(J, 2) <> "" Then
                For N = 1 To R
                    If sArr(N, 3) <> "" Then
                        K = K + 1
                        dArr(K, 1) = sArr(I, 1) & Str & sArr(J, 2) & Str & sArr(N, 3)
                    End If
                Next N
            End If
        Next J
    End If
Next I
Range("F2").Resize(K) = dArr
End Sub

Quá đúng rồi ạ.. Em cảm ơn Thầy nhiều nhiều.. Chúc Thầy Sức Khỏe và Thành Công ạ...

Cảm ơn cả nhà GPEX đã giúp em hoàn thành dự án ạ.!!

 

[ngoctuyen1995]

Quá nhiều lần giải thích mà chẳng ai hiểu.
Đến kết quả mẫu cũng không đúng "quy luật".
O1+A+B
O1+A+B1
O1+A+B10
O1+A+B11
...........
Kết quả cột C lấy B1 rồi đến B10 ?
Là sao ta. Híc!

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, R As Long, Str As String
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 3).Value2
R = UBound(sArr): Str = Range("D2").Value2
ReDim dArr(1 To R ^ 3, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        For J = 1 To R
            If sArr(J, 2) <> "" Then
                For N = 1 To R
                    If sArr(N, 3) <> "" Then
                        K = K + 1
                        dArr(K, 1) = sArr(I, 1) & Str & sArr(J, 2) & Str & sArr(N, 3)
                    End If
                Next N
            End If
        Next J
    End If
Next I
Range("F2").Resize(K) = dArr
End Sub

Chào Thầy..!
Em làm phiênThầy giúp em một bước nữa nhé..!
Khi em xóa 1 giá trị ở Cột A thì nó lại chạy sai ạ:
Vd: Ban đầu: Cột A = 12 (Giá trị), Cột B =11, Cột C = 12.... Tổng cộng : 12 * 11 * 12 = 1584 (đúng)
khi em xóa giá trị ở cột A: A = 2, B = 11, C = 12.... Tổng cộng: 2 * 11 * 12 = 264.. Nhưng macro mình chạy ra chỉ có 8 giá trị ạ....

Mong thầy giúp đỡ ạ

 

[Ba Tê]

Chào Thầy..!
Em làm phiênThầy giúp em một bước nữa nhé..!
Khi em xóa 1 giá trị ở Cột A thì nó lại chạy sai ạ:
Vd: Ban đầu: Cột A = 12 (Giá trị), Cột B =11, Cột C = 12.... Tổng cộng : 12 * 11 * 12 = 1584 (đúng)
khi em xóa giá trị ở cột A: A = 2, B = 11, C = 12.... Tổng cộng: 2 * 11 * 12 = 264.. Nhưng macro mình chạy ra chỉ có 8 giá trị ạ....

Mong thầy giúp đỡ ạ

Tách rời cột kết quả ra khỏi 4 cột đầu.

 

[ngoctuyen1995]

Tách rời cột kết quả ra khỏi 4 cột đầu.

Ok.. Em làm được rồi ạ.. Cảm ơn Thầy nhiều nha !
Cảm ơn cả nhà..!