请大神帮忙写一段代码，将一个不连续的区域中的数值依次写入一个一维数组中。

fbj-Excel

数组的应用对我来说实在有一些复杂，把一个连续selection写入数组还搞得定。
不连续的selection要对子区域areas循环操作写入，本人实在搞不定。请大神帮忙：
写一段代码，将这个不连续的selection中的数值依次写入一个一维数组中。
本例中黄色区域为selection，是一不连续区域。实际使用中selection选择的区域可能不同，

要求将任意选择的不连续区域(selection)中的数值依次写入一个一维数组中。
工作簿1.zip (7.63 KB, 下载次数: 8)

2023-4-6 16:28 上传

点击文件名下载附件

盼盼198310

...............

gwjkkkkk

Sub test()
    Dim ar(), rngCel As Range
    For Each rngCel In Selection
        r = r + 1
        ReDim Preserve ar(1 To r)
        ar(r) = rngCel
    Next
End Sub

fbj-Excel

gwjkkkkk 发表于 2023-4-6 18:19
Sub test()
    Dim ar(), rngCel As Range
    For Each rngCel In Selection

非常感谢，非常好。我想了半天没搞定，你几句代码就搞定了。

fbj-Excel

盼盼198310 发表于 2023-4-6 17:34
...............

满足并超出了我的需要。Very good！非常感谢！

lushang2018

perfect131

不推荐用 ReDim Preserve 跟 Application.Transpose，一个降速，一个超过3万左右#N/A了
arras 跟 for each

1. Sub kong() '''Areas
   
2.     If TypeName(Selection) = "Range" Then
   
3.         aa = Selection.Count
   
4.         If aa > 1 Then
   
5.             Set bb = Selection.Areas
   
6.             ReDim arr(1 To aa): cc = 0
   
7.             For i = 1 To bb.Count
   
8.                 If IsArray(bb(i).Value2) Then
   
9.                     For Each hh In bb(i).Value2
   
10.                         cc = cc + 1
    
11.                         arr(cc) = hh
    
12.                     Next
    
13.                 Else
    
14.                     cc = cc + 1
    
15.                     arr(cc) = bb(i).Value2
    
16.                 End If
    
17.             Next
    
18.         Else
    
19.             arr = Selection.Value
    
20.         End If
    
21.     End If
    
22. End Sub
    
23. Sub kong1() ''for Each
    
24.     If TypeName(Selection) = "Range" Then
    
25.         ReDim arr(1 To Selection.Count): r = 0
    
26.         For Each rngCel In Selection
    
27.             r = r + 1
    
28.             arr(r) = rngCel.Value
    
29.         Next
    
30.     End If
    
31. End Sub

复制代码

selen

将不连续的 Selection 中的数值依次写入一个一维数组中的代码：

Sub ReadSelectionValues()

    Dim arrValues() As Variant ' 声明一个 Variant 类型的数组
    Dim r As Range ' 声明一个 Range 类型的变量
    Dim i As Long ' 声明一个 Long 类型的计数器

    ' 遍历当前选择的每个区域
    For Each r In Selection.Areas
        ' 将区域中的数值存入数组中
        For i = 1 To r.Cells.Count
            ReDim Preserve arrValues(1 To i)
            arrValues(i) = r.Cells(i).Value
        Next i
    Next r

    ' 在 Immediate 窗口中打印数组中的数值
    Debug.Print Join(arrValues, ",")

End Sub
这个 VBA 子过程遍历当前选择中的每个区域，将区域中的数值存入一个 Variant 类型的数组中，并通过 Join 函数将数组中的数值转换为一个字符串并在 Immediate 窗口中输出。如果需要在其他地方使用这些数值，可以直接访问数组 arrValues。