excel不连续的列怎么赋值进一个数组啊？

ztsss161511

求大佬们给看下！~怎么把EXCEL表格中不连续的列快速放入一个数组啊？比如表1中：B,D,H列快速放入数组arr中，我写的代码不行啊？
Dim arr1,arr2,arr3,s,arr
s = Worksheets("表1").Cells(Rows.Count, "A").End(xlUp).Row
arr1 = Worksheets("表1").Range("B2:B" & s)
arr2 = Worksheets("表1").Range("D5:D" & s)
arr3 = Worksheets("表1").Range("H5:H" & s)
arr = Array(arr1, arr2, arr3)
arr=WorksheetFunction.Transpose(arr)

abc123281

测试.rar (16.59 KB, 下载次数: 8)

2024-7-24 00:27 上传

点击文件名下载附件

liuyu5863016

1. Dim arr1,arr2,arr3,s,arr
   
2. s = Worksheets("表1").Cells(Rows.Count, "A").End(xlUp).Row
   
3. arr1 = Worksheets("表1").Range("B2:B" & s)
   
4. arr2 = Worksheets("表1").Range("D5:D" & s)
   
5. arr3 = Worksheets("表1").Range("H5:H" & s)
   
6. arr = Array(arr1, arr2, arr3)

复制代码

到这里已经是一个数组了啊

ynzsvt

逐个赋值才行。

ykcbf1100

写入数组，这个其实简单

ykcbf1100

写入数组。。。

1. Sub ykcbf()  '//2024.7.24 数据写入数组中
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     b = [{2,4,8}]
   
4.     ReDim arr(1 To r, 1 To 3)
   
5.     For i = 2 To r
   
6.         m = m + 1
   
7.         For j = 1 To UBound(b)
   
8.             arr(m, j) = Cells(i, b(j))
   
9.         Next
   
10.     Next
    
11.     MsgBox "数组arr已写入完成！"
    
12. End Sub
    

复制代码

边缘码农

边缘码农

1. Sub Test1()
   
2.     Dim MaxRow As Long
   
3.     Dim Col As Variant, RowOffset As Variant
   
4.     Dim I As Long, J As Long, K As Long
   
5.     MaxRow = Cells(Rows.Count, 1).End(3).Row
   
6.     Col = [{2,4,8}]
   
7.     RowOffset = [{0,3,3}]
   
8.     ReDim arr(1 To MaxRow - 1, 1 To 3)
   
9.     For I = 2 To MaxRow
   
10.         m = m + 1
    
11.         For K = 1 To UBound(RowOffset)
    
12.             For J = 1 To UBound(Col)
    
13.                 arr(m, J) = Cells(I + RowOffset(J), Col(J))
    
14.             Next
    
15.         Next
    
16.     Next
    
17.     Stop
    
18. End Sub

复制代码

边缘码农

多了一重不必要循环。

usedrange

1. Sub t()
   
2.     Dim arr, m%, wb, r%
   
3.     m = ActiveSheet.[a1].End(4).Row
   
4.     Set wb = Union(Range("b1:b" & m), Range("d1:d" & m), Range("h1:h" & m))
   
5.     ReDim arr(1 To m * 3, 1 To 1)
   
6.     r = 1
   
7.     For Each k In wb.Cells
   
8.         arr(r, 1) = k
   
9.         r = r + 1
   
10.     Next k
    
11.     [j1].Resize(UBound(arr), 1) = arr
    
12.     Set wb = Nothing
    
13. End Sub

复制代码