Nối các cấu kiện theo điều kiện

[hongphuong1997]

Nhờ các bác và anh chị giúp đỡ như file đính kèm

 

[hongphuong1997]

Em xin giải thích vắn tắt của bài như sau
Nhờ các thầy và anh chị giúp đỡ

 

[snow25]

Em xin giải thích vắn tắt của bài như sau
Nhờ các thầy và anh chị giúp đỡ

em dán code này vào chạy thử xem thế nào nhé

Sub ketqua()
Dim a, b, c, d, i, j As Long
Dim dk, dks As String
Dim arr, arr1, arr2
arr1 = Sheet1.Range("b3:c11").Value
arr2 = Sheet1.Range("f15:h24").Value
ReDim arr(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
  a = a + 1
   For j = 1 To UBound(arr2, 1)
       dk = arr1(i, 1) & arr1(i, 2)
       dks = arr2(j, 1) & arr2(j, 2)
       If dk = dks Then
         If arr(a, 1) = Empty Then
         arr(a, 1) = arr2(j, 3)
         Else
        arr(a, 1) = arr(a, 1) & "," & arr2(j, 3)
        End If
       End If
   Next j
Next i
Sheet1.Range("d3").Resize(a, 1).Value = arr
End Sub

 

[concogia]

Em xin giải thích vắn tắt của bài như sau
Nhờ các thầy và anh chị giúp đỡ

Em xin giải thích vắn tắt của bài như sau
Nhờ các thầy và anh chị giúp đỡ

[B10]=8, [C10]=9 ==> a8 ==> không lấy_ tức là phải từ 2 trở lên mới nối ???

 

[hongphuong1997]

em dán code này vào chạy thử xem thế nào nhé

Sub ketqua()
Dim a, b, c, d, i, j As Long
Dim dk, dks As String
Dim arr, arr1, arr2
arr1 = Sheet1.Range("b3:c11").Value
arr2 = Sheet1.Range("f15:h24").Value
ReDim arr(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
  a = a + 1
   For j = 1 To UBound(arr2, 1)
       dk = arr1(i, 1) & arr1(i, 2)
       dks = arr2(j, 1) & arr2(j, 2)
       If dk = dks Then
         If arr(a, 1) = Empty Then
         arr(a, 1) = arr2(j, 3)
         Else
        arr(a, 1) = arr(a, 1) & "," & arr2(j, 3)
        End If
       End If
   Next j
Next i
Sheet1.Range("d3").Resize(a, 1).Value = arr
End Sub

Em cảm ơn anh
rất đúng anh ơi
Anh có thể viết thành fun() để em vận dụng cho linh hoạt được không anh?

Bài đã được tự động gộp: 19/10/18

[B10]=8, [C10]=9 ==> a8 ==> không lấy_ tức là phải từ 2 trở lên mới nối ???

Bác ơi chỗ đó là cháu không nhìn thấy bác à
Có lấy bác ơi

 

[concogia]

Em cảm ơn anh
rất đúng anh ơi
Anh có thể viết thành fun() để em vận dụng cho linh hoạt được không anh?

Bài đã được tự động gộp: 19/10/18

Bác ơi chỗ đó là cháu không nhìn thấy bác à
Có lấy bác ơi

Vậy thì "zì":

Public Function Gom(Vung, Dk, Cd) As String
    Dim Tam, I, Kq
    Tam = Dk & "@" & Cd
        For I = 1 To Vung.Rows.Count
            If Vung(I, 1) & "@" & Vung(I, 2) = Tam Then Kq = Kq & Vung(I, 3) & " "
        Next I
    Gom = Replace(Trim(Kq), " ", "; ")
End Function

Cell lấy kết quả:

=gom($F$15:$H$24,B3,C3)

Thân

 

[befaint]

For i = 1 To UBound(arr1, 1)
a = a + 1
For j = 1 To UBound(arr2, 1)
dk = arr1(i, 1) & arr1(i, 2)

- Không cần thêm biến a, lấy theo biến i luôn.
- Cho dòng "dk = arr1(i, 1) & arr1(i, 2)" lên phía trước dòng "For j = 1 To UBound(arr2, 1)"

 

[hongphuong1997]

Vậy thì "zì":

Public Function Gom(Vung, Dk, Cd) As String
    Dim Tam, I, Kq
    Tam = Dk & "@" & Cd
        For I = 1 To Vung.Rows.Count
            If Vung(I, 1) & "@" & Vung(I, 2) = Tam Then Kq = Kq & Vung(I, 3) & " "
        Next I
    Gom = Replace(Trim(Kq), " ", "; ")
End Function

Cell lấy kết quả:

=gom($F$15:$H$24,B3,C3)

Thân

Cháu cảm ơn bác
Công thức rất đúng bác ơi
Nhưng có mỗi nhược điểm là chưa thuận lợi cho lắm
Cháu muốn fun() này làm add in (Vì cháu phải dùng công thức này thường xuyên)
Trong công thức bác để vùng lấy kết quả là cột thứ 3 (Cố định)
Vì vậy mỗi khi vùng có số cột khác nhau thì lại phải sửa trong code
bác có thể sửa lại cho cháu chút xíu được không hở bác?

 

[concogia]

Cháu cảm ơn bác
Công thức rất đúng bác ơi
Nhưng có mỗi nhược điểm là chưa thuận lợi cho lắm
Cháu muốn fun() này làm add in (Vì cháu phải dùng công thức này thường xuyên)
Trong công thức bác để vùng lấy kết quả là cột thứ 3 (Cố định)
Vì vậy mỗi khi vùng có số cột khác nhau thì lại phải sửa trong code
bác có thể sửa lại cho cháu chút xíu được không hở bác?

Tại dữ liệu bạn đưa như thế.
"Bi giờ", bạn tách thằng "Vung" ra làm 2:
1) "VungDk" (2 cột) dùng để dò thằng Dk & Cd,
2) "VungKq" (1 cột_cột thứ 3, muốn nằm đâu thì nằm) dùng để trả kết quả khi 2 cột của thằng "VungDk" = Dk & Cd
Đại khái là thế này:
=Gom(VungDk,VungKq,Dk,Cd)
Thân

 

[hongphuong1997]

Tại dữ liệu bạn đưa như thế.
"Bi giờ", bạn tách thằng "Vung" ra làm 2:
1) "VungDk" (2 cột) dùng để dò thằng Dk & Cd,
2) "VungKq" (1 cột_cột thứ 3, muốn nằm đâu thì nằm) dùng để trả kết quả khi 2 cột của thằng "VungDk" = Dk & Cd
Đại khái là thế này:
=Gom(VungDk,VungKq,Dk,Cd)
Thân

bác ơi, bác sửa cho cháu với
cháu không biết sửa như nào bác ơi

 

[concogia]

bác ơi, bác sửa cho cháu với
cháu không biết sửa như nào bác ơi

Trơ..ơ...ờ...i

Public Function Gom(VungDk, VungKq, Dk, Cd) As String
    Dim Tam, I, Kq
    Tam = Dk & "@" & Cd
        For I = 1 To VungDk.Rows.Count
            If VungDk(I, 1) & "@" & VungDk(I, 2) = Tam Then Kq = Kq & VungKq(I, 1) & " "
        Next I
    Gom = Replace(Trim(Kq), " ", "; ")
End Function

công thức

=gom($F$15:$G$24,$H$15:$H$24,B3,C3)

H15:H24 là cột thứ 3, muốn ở đâu thì khai báo ở đó
Thân

 

[hongphuong1997]

Trơ..ơ...ờ...i

Public Function Gom(VungDk, VungKq, Dk, Cd) As String
    Dim Tam, I, Kq
    Tam = Dk & "@" & Cd
        For I = 1 To VungDk.Rows.Count
            If VungDk(I, 1) & "@" & VungDk(I, 2) = Tam Then Kq = Kq & VungKq(I, 1) & " "
        Next I
    Gom = Replace(Trim(Kq), " ", "; ")
End Function

công thức

=gom($F$15:$G$24,$H$15:$H$24,B3,C3)

H15:H24 là cột thứ 3, muốn ở đâu thì khai báo ở đó
Thân

Cháu cảm ơn bác rất nhiều
cháu lấy công thức này làm Add in bác à
Công nhận VBA quá lợi hại bác Gacon nhỉ...