这个宏怎么写？

yizhimoshou

这个宏命令怎么写

yizhimoshou

00000000000000000..............

zjdh

惜字如金！！

yynrzwh

fzxba

Sub test0()
  Dim a, b, c()
  Dim i As Long, j As Long, k As Long
  Dim x As Long, y As Long
  a = Range("A1").CurrentRegion.Resize(, 7)
  b = Range("I1").CurrentRegion.Resize(, 3)
  ReDim c(1 To UBound(a) * UBound(b), 1 To UBound(a, 2) + UBound(b, 2))
  For i = 1 To UBound(a)
    For y = 1 To UBound(b)
      k = k + 1
      For x = 1 To UBound(a, 2)
        c(k, x) = a(i, x)
      Next
      For j = 1 To UBound(b, 2)
        c(k, x) = b(y, j)
        x = x + 1
      Next
    Next
  Next
  Range("M1").Resize(k, UBound(c, 2)) = c
End Sub

yizhimoshou

yynrzwh 发表于 2024-3-3 15:40

提示语法错误

yizhimoshou

Sub CombineData()
    Dim ar As Range, br As Range, cr() As Variant
    Dim a As Long, b As Long, a1 As Long, b1 As Long
    Dim i As Long, ii As Long, j As Long, r As Long
   
    ' 获取第一个数据范围
    Set ar = Range("A1").Resize(ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row, 1)
    ' 获取第二个数据范围
    Set br = Range("I1").Resize(ActiveSheet.Cells(ActiveSheet.Rows.Count, "I").End(xlUp).Row, 1)
   
    ' 获取数据范围的行数和列数
    a = ar.Rows.Count: b = br.Rows.Count
    a1 = ar.Columns.Count: b1 = br.Columns.Count
   
    ' 初始化结果数组
    ReDim cr(1 To a * b, 1 To a1 + b1)
   
    ' 将第一个数据范围的数据复制到结果数组
    For i = 1 To a
        For j = 1 To a1
            cr(r + 1, j) = ar(i, j)
        Next j
        ' 将第二个数据范围的数据复制到结果数组
        For ii = 1 To b
            For j = a1 + 1 To a1 + b1
                cr(r + 1, j) = br(ii, j - a1)
            Next j
            r = r + 1
        Next ii
    Next i
   
    ' 将结果数组输出到指定位置
    Range("M1").Resize(UBound(cr, 1), UBound(cr, 2)).Value = cr
End Sub
这样写，怎么完善？

yynrzwh

1. Sub test()
   
2. 
   
3. ar = Range("a1").CurrentRegion
   
4. br = Range("i1").CurrentRegion
   
5. a = UBound(ar): b = UBound(br)
   
6. a1 = UBound(ar, 2): b1 = UBound(br, 2)
   
7. ReDim cr(1 To a * b, 1 To a1 + b1)
   
8. 
   
9.     For i = 1 To a
   
10.         For ii = 1 To b
    
11.             r = r + 1
    
12.             For j = 1 To a1
    
13.                 cr(r, j) = ar(i, j)
    
14.             Next
    
15.             For j = a1 + 1 To UBound(cr, 2)
    
16.                 cr(r, j) = br(ii, j - a1)
    
17.             Next
    
18.         Next
    
19.     Next
    
20.    
    
21. Range("m1").Resize(r, UBound(cr, 2)) = cr
    
22. End Sub

复制代码

qdtzq

参与一下.........

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, cr, i&, k&, m&, n&, r&, iRow&
   
    iRow = Cells(Rows.Count, "A").End(xlUp).Row
    ar = Range("A1:G" & iRow).Value
    iRow = Cells(Rows.Count, "I").End(xlUp).Row
    br = Range("I1:K" & iRow).Value
    ReDim cr(1 To UBound(ar) * UBound(br), UBound(ar) + UBound(br))
   
    For i = 1 To UBound(ar)
        For k = 1 To UBound(br)
            r = r + 1
            For m = 1 To UBound(ar, 2)
                cr(r, m) = ar(i, m)
            Next m
            For n = 1 To UBound(br, 2)
                cr(r, UBound(ar, 2) + n) = br(k, n)
            Next n
        Next k
    Next i
   
    [Y1].Resize(UBound(cr), UBound(cr, 2)) = cr
    Beep
End Sub