Giúp bổ sung code find theo file đính kèm (2 người xem)

[lhthai]

Chào các Anh GPE
Hiện tại thấy code của anh cá ngừ F1 hay nên vận dụng vào file mình
Nay muốn bổ sung thêm cột AJ có kế quả như cột N
Hiện tại cột N & AJ có giá trị rồi mình muốn kết quả sheet2 nối chuỗi với cột N & AJ
Ví dụ như cột AJ có giá trị W thì kết quả sẽ là AW

 

[Cá ngừ F1]

Chào các Anh GPE
Hiện tại thấy code của anh cá ngừ F1 hay nên vận dụng vào file mình
Nay muốn bổ sung thêm cột AJ có kế quả như cột N
Hiện tại cột N & AJ có giá trị rồi mình muốn kết quả sheet2 nối chuỗi với cột N & AJ
Ví dụ như cột AJ có giá trị W thì kết quả sẽ là AW

Ặc ặc.. cốt này ko phải của mình đâu, mình học mót trên GPE thôi.
Mà câu hỏi của bạn mình đọc ko hiểu j luôn. hjk

 

[lhthai]

Ặc ặc.. cốt này ko phải của mình đâu, mình học mót trên GPE thôi.
Mà câu hỏi của bạn mình đọc ko hiểu j luôn. hjk

hiện tại mình áp dụng được cột N rồi bây giờ muốn bổ sung thêm kết quả cột AJ giống cột N

 

[ChanhTQ@]

Bạn thử với cái ni:

Option Explicit
Sub SoTK()
    Dim MSCN(), SoTaiKhoan()
    Dim I As Long, Str As Range, J As Byte
    
    Application.ScreenUpdating = False
    For J = 7 To 30 Step 22
        With Sheet1
            MSCN = .Range(.Cells(10, J), .Cells(65000, J).End(xlUp)).Value
        End With
        ReDim SoTaiKhoan(1 To UBound(MSCN), 1 To 1)
        For I = 1 To UBound(MSCN)
            Set Str = Sheet2.[A:A].Find(MSCN(I, 1), , , xlWhole)
            If Not Str Is Nothing And MSCN(I, 1) <> vbNullString Then
                SoTaiKhoan(I, 1) = Str.Offset(, 2)
            End If
        Next
        Sheet1.Cells(10, J + 7).Resize(I - 1, 1) = SoTaiKhoan
        Set Str = Nothing
    Next J
    Application.ScreenUpdating = True
End Sub

 

[lhthai]

Bạn thử với cái ni:

Option Explicit
[CODE]Sub SoTK()
    Dim MSCN(), SoTaiKhoan()
    Dim I As Long, Str As Range, J As Byte
    
    Application.ScreenUpdating = False
    For J = 7 To 30 Step 22
        With Sheet1
            MSCN = .Range(.Cells(10, J), .Cells(65000, J).End(xlUp)).Value
        End With
        ReDim SoTaiKhoan(1 To UBound(MSCN), 1 To 1)
        For I = 1 To UBound(MSCN)
            Set Str = Sheet2.[A:A].Find(MSCN(I, 1), , , xlWhole)
            If Not Str Is Nothing And MSCN(I, 1) <> vbNullString Then
                SoTaiKhoan(I, 1) = Str.Offset(, 2)
            End If
        Next
        Sheet1.Cells(10, J + 7).Resize(I - 1, 1) = SoTaiKhoan
        Set Str = Nothing
    Next J
    Application.ScreenUpdating = True
End Sub[/CODE]

Từ code này mình muốn thêm điều kiện ở cột N & AJ như sau được không
Nếu cột N & AJ có chữ A thì không thêm A
Nếu cột N & AJ có chữ W hoặc N thì nối kết quả vừa tìm với cột hiện N & AJ
Vd tại cột N có chữ W thì cho kết quả AW

 

[Cá ngừ F1]

Có phải ý bạn là thế này:
[GPECODE=vb]Sub SoTK()
Application.ScreenUpdating = False
Dim MSCN(), MSCN1(), SoTaiKhoan(), SoTaiKhoan1()
Dim i As Long, Str As Range, Str1 As Range
On Error Resume Next
With Sheet1
MSCN = .Range(.[G10], .[G65000].End(3)).Value
MSCN1 = .Range(.[AC10], .[AC65000].End(3)).Value
End With
ReDim SoTaiKhoan(1 To UBound(MSCN), 1 To 1)
ReDim SoTaiKhoan1(1 To UBound(MSCN), 1 To 1)
For i = 1 To UBound(MSCN)
Set Str = Sheet2.[A:A].Find(MSCN(i, 1), , , 1)
Set Str1 = Sheet2.[A:A].Find(MSCN1(i, 1), , , 1)
If Not Str Is Nothing Then
SoTaiKhoan(i, 1) = Str.Offset(, 2)
End If
If Not Str1 Is Nothing Then
SoTaiKhoan1(i, 1) = Str1.Offset(, 2)
End If
Next
Sheet1.[N10].Resize(i - 1, 1) = SoTaiKhoan
Sheet1.[AJ10].Resize(i - 1, 1) = SoTaiKhoan1
Set Str = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]