Hàm ghép cột 1 với từng giá trị trong cột 2

[congdaittb]

E muốn tạo ra một cột bằng cách ghép từng giá trị của cột 2 với một list trong cột 1 ra một cột mới.
Các bác xem hình để rõ hơn nhá:

​

 

[ngodany135]

E muốn tạo ra một cột bằng cách ghép từng giá trị của cột 2 với một list trong cột 1 ra một cột mới.
Các bác xem hình để rõ hơn nhá:

Tại C2=A2&":"&B2
Các cột khác tương tự

 

[qtm1987]

Bạn sử dụng & để nối lại thôi. Nhớ trị tuyệt đối giá trị bên $B$2 và $B$3
Công thức tại C2 =A2 & ":" & $B$2 kéo công thức này xuống tới C6
Công thức tại C7 =A2 & ":" & $B$3 kéo công thức này xuống tới C11

 

[congdaittb]

Bạn sử dụng & để nối lại thôi. Nhớ trị tuyệt đối giá trị bên $B$2 và $B$3
Công thức tại C2 =A2 & ":" & $B$2 kéo công thức này xuống tới C6
Công thức tại C7 =A2 & ":" & $B$3 kéo công thức này xuống tới C11

e muốn tạo một hàm làm tự động, chứ làm vậy thì với trường hợp danh sách dài thì rất mất công và thời gian.
Bác nào biết mong giúp đỡ.

 

[qtm1987]

e muốn tạo một hàm làm tự động, chứ làm vậy thì với trường hợp danh sách dài thì rất mất công và thời gian.
Bác nào biết mong giúp đỡ.

muốn vậy chắc chỉ viết code thôi. Bạn up file lên đi. Có file thì người xem mới giúp đc bạn chứ.

 

[congdaittb]

muốn vậy chắc chỉ viết code thôi. Bạn up file lên đi. Có file thì người xem mới giúp đc bạn chứ.

Cái file đó nặng quá, gần 10mb mỗi file mấy MB, nên up lên lâu lắm.
bác nào có thể giúp e cái code với ví dụ dưới không, e xin cảm ơn các bác.

 

[nghiaphuc]

Cái file đó nặng quá, gần 10mb mỗi file mấy MB, nên up lên lâu lắm.
bác nào có thể giúp e cái code với ví dụ dưới không, e xin cảm ơn các bác.

Bạn thử code này xem sao:

Sub GhepDL()
    Dim i As Long, j As Long, r As Long
    r = Cells.Rows.Count
    Sheet1.Activate
    For i = 2 To Cells(r, 1).End(xlUp).Row
        For j = 2 To Cells(r, 2).End(xlUp).Row
            Cells(r, 3).End(xlUp).Offset(1) = Cells(i, 1) & ":" & Cells(j, 2)
        Next
    Next
End Sub

 

[ndu96081631]

E muốn tạo ra một cột bằng cách ghép từng giá trị của cột 2 với một list trong cột 1 ra một cột mới.
Các bác xem hình để rõ hơn nhá:

Tặng bạn code này:

Function CombineArray(ByVal sArray1, ByVal sArray2, Optional Sep As String = "")
  Dim tmpArr1, tmpArr2, Arr() As String, aResult(), Item1, Item2, tmp
  Dim lR As Long, i As Long
  On Error Resume Next
  If IsArray(sArray1) Then
    tmpArr1 = sArray1
  Else
    ReDim tmpArr1(1 To 1, 1 To 1)
    tmpArr1(1, 1) = sArray1
  End If
  If IsArray(sArray2) Then
    tmpArr2 = sArray2
  Else
    ReDim tmpArr2(1 To 1, 1 To 1)
    tmpArr2(1, 1) = sArray2
  End If
  For Each Item1 In tmpArr1
    If CStr(Item1) <> "" Then
      For Each Item2 In tmpArr2
        If CStr(Item2) <> "" Then
          lR = lR + 1
          ReDim Preserve Arr(1 To lR)
          tmp = Item2 & Sep & Item1
          Arr(lR) = tmp
        End If
      Next
    End If
  Next
  If lR Then
    ReDim aResult(1 To UBound(Arr), 1 To 1)
    For i = 1 To UBound(Arr)
      aResult(i, 1) = Arr(i)
    Next
    CombineArray = aResult
  End If
End Function

Bạn có 2 lựa chọn:
1> Dùng công thức trực tiếp trên bảng tính:
Quét chọn vùng cần đặt kết quả (chẳng hạn là F2:F10) rồi gõ vào thanh Formula công thức =CombineArray(B2:B3,A2:A6,":") xong bấm tổ hợp Ctrl + Shift + Enter để kết thúc
2> Dùng Sub để gán kết quả:

Sub Main()
  Dim sArray1, sArray2, aResult
  sArray1 = Range("B2:B60000").Value
  sArray2 = Range("A2:A60000").Value
  On Error Resume Next
  aResult = CombineArray(sArray1, sArray2, ":")
  Range("F2").Resize(UBound(aResult, 1)).Value = aResult
End Sub

-----------------------
Ưu điểm của code:
- Làm việc được với Range và Array
- Mảng 1 chiều hay 2 chiều đều chơi tuốt