Nối các mảng lại với nhau trong VBA

[duyhuynh9922]

Xin chào các anh chị trong diễn đàn, hiện nay em đang có 1 thắc mắc trong việc nối các mảng đơn lại với nhau.
Cụ thể nếu dùng hàm Join() thì sẽ bị lỗi "Can't assign to array". Mong các anh chị giúp đỡ về vấn đề này.
Trong ví dụ bên dưới em dùng vòng lặp để ghép lại. File là copy từ 1 chủ đề khác.

 

[snow25]

Xin chào các anh chị trong diễn đàn, hiện nay em đang có 1 thắc mắc trong việc nối các mảng đơn lại với nhau.
Cụ thể nếu dùng hàm Join() thì sẽ bị lỗi "Can't assign to array". Mong các anh chị giúp đỡ về vấn đề này.
Trong ví dụ bên dưới em dùng vòng lặp để ghép lại. File là copy từ 1 chủ đề khác.

Khả năng lỗi,mảng nhiều chiều.Chưa xem code.

 

[BuiQuangThuan]

Join chỉ nối mảng 1 chiều thì phải

 

[duyhuynh9922]

Khả năng lỗi,mảng nhiều chiều.Chưa xem code.

Cảm ơn anh, để em xem lại phần khai báo của em!

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

Join chỉ nối mảng 1 chiều thì phải

Cảm ơn nghen!

 

[VetMini]

Khả năng lỗi,mảng nhiều chiều.Chưa xem code.

Join chỉ nối mảng 1 chiều thì phải

Theo tôi hiểu thì thớt muốn nối nhiều mảng với nhau thành một mảng.
Hàm Join của VBA là nối các phần tử của mảng thành chuỗi. Và chuỗi (kết quả của Join) không thể gán cho mảng. Câu báo lỗi nhưu bài #1 có nói rõ.

 

[HUONGHCKT]

Xin chào các anh chị trong diễn đàn, hiện nay em đang có 1 thắc mắc trong việc nối các mảng đơn lại với nhau.
Cụ thể nếu dùng hàm Join() thì sẽ bị lỗi "Can't assign to array". Mong các anh chị giúp đỡ về vấn đề này.
Trong ví dụ bên dưới em dùng vòng lặp để ghép lại. File là copy từ 1 chủ đề khác.

Bạn có thể tham khảo hàm UDF này của anh @HeSanbi
Hy vọng có thể giúp ích được phần nào.

Option Explicit
'Tác gi? Hesanbi-GPE
Function ArrayMerge(ParamArray Arrays() As Variant)
  On Error Resume Next
  Dim R(), v, a, c1&, c2&, x&, y&, z&, lb1&, ub1&, lb2&, ub2&
  c2 = 1
  For Each a In Arrays: v = a
    VBA.Err.Clear: lb1 = LBound(v): ub1 = UBound(v)
    If VBA.Err = 0 Then
      c1 = c1 + ub1 - lb1 + 1
      VBA.Err.Clear: lb2 = LBound(v, 2): ub2 = UBound(v, 2)
      If VBA.Err = 0 Then
        z = ub2 - lb2 + 1: If z > c2 Then c2 = z
      End If
    End If
  Next
  ReDim R(1 To c1, 1 To c2): c1 = 0
  For Each a In Arrays: v = a
    VBA.Err.Clear: lb1 = LBound(v): ub1 = UBound(v)
    If VBA.Err = 0 Then
      VBA.Err.Clear: lb2 = LBound(v, 2): ub2 = UBound(v, 2)
      If VBA.Err = 0 Then
        For x = lb1 To ub1
          For y = lb2 To ub2
            R(x + c1 - lb1 + 1, y - lb2 + 1) = IIf(v(x, y) = Empty, vbNullString, v(x, y))
          Next
          For z = y - lb2 + 1 To c2
            R(x + c1 - lb1 + 1, z) = vbNullString
          Next
        Next
      Else
        For x = lb1 To ub1
          R(x + c1 - lb1 + 1, 1) = IIf(v(x) = Empty, vbNullString, v(x))
          For z = 2 To c2
            R(x + c1 - lb1 + 1, z) = vbNullString
          Next
        Next
      End If
      c1 = c1 + ub1 - lb1 + 1
    End If
  Next
  ArrayMerge = R
  On Error GoTo 0
End Function

Cú pháp: =ArrayMerge(B2:B79;E2:E39) và enter

 

[HeSanbi]

=Merge("1", "2", 3, 4, A1:A100, B1:B100)

Function Merge(ParamArray Arrays() As Variant)
  On Error Resume Next
  Dim R(), v, a, c1&, c2&, x&, y&, z&, lb1&, ub1&, lb2&, ub2&, m&, n&
  c2 = 1
  For Each a In Arrays: v = a
    Err.clear: lb1 = LBound(v): ub1 = UBound(v)
    If Err = 0 Then
      c1 = c1 + ub1 - lb1 + 1
      Err.clear: lb2 = LBound(v, 2): ub2 = UBound(v, 2)
      If Err = 0 Then z = ub2 - lb2 + 1: If z > c2 Then c2 = z
    Else
      c1 = c1 + 1
    End If
  Next
  ReDim R(1 To c1, 1 To c2): c1 = 0
  For Each a In Arrays: v = a
    Err.clear: lb1 = LBound(v): ub1 = UBound(v)
    If Err = 0 Then
      Err.clear: lb2 = LBound(v, 2): ub2 = UBound(v, 2): n = c1 - lb1 + 1
      If Err = 0 Then
        m = lb2 + 1
        For x = lb1 To ub1
          For y = lb2 To ub2: R(x + n, y - m) = IIf(v(x, y) = Empty, vbNullString, v(x, y)): Next
          For z = y - m To c2: R(x + n, z) = vbNullString: Next
        Next
      Else
        For x = lb1 To ub1
          R(x + n, 1) = IIf(v(x) = Empty, vbNullString, v(x))
          For z = 2 To c2: R(x + n, z) = vbNullString: Next
        Next
      End If
      c1 = n + ub1
    Else
      c1 = c1 + 1: R(c1, 1) = v
    End If
  Next
  Merge = R
  On Error GoTo 0
End Function