Sub 数组() Dim arr() Dim xb% arr = Sheet2.Cells.Range("b2", [i2].End(xlDown)) For xb = 1 To UBound(arr) Sheet1.Cells.Range("a1") = arr(xb, 7) Sheet1.Cells.Range("d2") = arr(xb, 1) Sheet1.Cells.Range("a3") = arr(xb, 2) Sheet1.Cells.Range("a4") = arr(xb, 3) Sheet1.Cells.Range("b5") = arr(xb, 6) Sheet1.Cells.Range("b6") = arr(xb, 4) Sheet1.Cells.Range("b7") = arr(xb, 8) Sheet1.Cells.Range("b8") = arr(xb, 5) Next End Sub
时间: 2024-03-31 14:36:24 浏览: 17
这是一段VBA代码,用于将Sheet2中的数据读取到数组中,并将数组中的数据写入到Sheet1中指定的单元格中。具体实现步骤如下:
1. 定义一个数组arr,并将Sheet2中的数据从"B2"开始读取到数组中,直到最后一个非空单元格。这里使用了End方法来自动识别最后一行的位置。
2. 使用For循环遍历数组arr,从第一个元素开始,到最后一个元素结束。
3. 在循环中,将数组中的第7列、第1列、第2列、第3列、第6列、第4列、第8列和第5列的数据,分别写入Sheet1中的"A1"、"D2"、"A3"、"A4"、"B5"、"B6"、"B7"和"B8"单元格中。
4. 循环结束后,数据写入完成。
需要注意的是,该代码中没有对读取到的数据进行有效性验证,如是否为数字、是否符合要求等,容易引起数据错误或程序崩溃。使用时需要根据实际情况进行修改和完善。
相关问题
String[] arr = “121”.split(""); int len = arr.length%2 == 0 ? arr.length/2 : (int) Math.ceil(arr.length/2);,len的值为什么?
变量 `len` 的值是根据数组 `arr` 的长度计算得出的。
首先,`arr.length` 表示数组 `arr` 的长度。接下来,使用三元运算符判断数组长度的奇偶性:
- 如果数组长度是偶数,即 `arr.length` 能够被 2 整除,那么 `len` 的值就是 `arr.length/2`。
- 如果数组长度是奇数,即 `arr.length` 除以 2 后有余数,那么 `len` 的值就是 `(int) Math.ceil(arr.length/2)`。
其中,`Math.ceil()` 方法用于向上取整,确保结果为一个整数。
通过这样的计算,我们可以得到一个长度为 `len` 的子数组,这个子数组的长度要么是原数组长度的一半(当原数组长度为偶数时),要么是原数组长度的一半加一(当原数组长度为奇数时)。
帮我合并以下宏程序 Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, cell As Range Dim arr() As Variant Dim cnt As Long Dim isCopying As Boolean ' 如果B1单元格为空,直接退出Sub过程 If Me.Range("B1").Value = "" Then Exit Sub If Not Intersect(Target, Me.Range("B1")) Is Nothing Then Sheets("点位提取").Range("C5:C200").ClearContents If Me.Range("AH34").Value = True Then Me.ListBox1.AddItem "数据已被清空 " & Format(Now, "hh:mm:ss") Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1 End If Set rng = Me.Range("B1:B2000") cnt = 0 isCopying = False For Each cell In rng If cell.Value = ":BEGIN" Then isCopying = True ReDim arr(2000) If Me.Range("AH34").Value = True Then Me.ListBox1.AddItem "开始提取数据 " & Format(Now, "hh:mm:ss") Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1 End If ElseIf cell.Value = ":END" Then isCopying = False ReDim Preserve arr(cnt - 1) Sheets("点位提取").Range("C5").Resize(cnt, 1).Value = Application.Transpose(arr) If Me.Range("AH34").Value = True Then Me.ListBox1.AddItem "数据已进行提取完毕 " & Format(Now, "hh:mm:ss") Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1 End If Exit For End If If isCopying And cell.Value <> ":BEGIN" Then arr(cnt) = rng.Cells(cell.Row, 1).Value cnt = cnt + 1 End If Next cell End If On Error GoTo ErrorHandler Exit Sub ErrorHandler: If Me.Range("AH36").Value = True Then Me.ListBox2.AddItem Err.Description & " " & Format(Now, "hh:mm:ss") Me.ListBox2.ListIndex = Me.ListBox2.ListCount - 1 End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim j As Integer Dim k As Integer Dim ws As Worksheet Set ws = ActiveSheet If Target.Address = "$B$2" Then For i = 9 To 40 For j = 2 To 7 If ws.Cells(i, j).Value = ws.Cells(8, 5).Value Then For k = 3 To 4 ws.Cells(i, j + k - 2).Value = ws.Cells(Application.Match(ws.Cells(i, 1).Value, ws.Range("AK9:AK40"), 0) + 8, k).Value Next k End If Next j Next i End If End Sub
可以将两个Sub过程合并为一个,代码如下:
```
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Dim arr() As Variant
Dim cnt As Long
Dim isCopying As Boolean
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
' 如果B1单元格为空,直接退出Sub过程
If Me.Range("B1").Value = "" Then Exit Sub
If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
Sheets("点位提取").Range("C5:C200").ClearContents
If Me.Range("AH34").Value = True Then
Me.ListBox1.AddItem "数据已被清空 " & Format(Now, "hh:mm:ss")
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
End If
Set rng = Me.Range("B1:B2000")
cnt = 0
isCopying = False
For Each cell In rng
If cell.Value = ":BEGIN" Then
isCopying = True
ReDim arr(2000)
If Me.Range("AH34").Value = True Then
Me.ListBox1.AddItem "开始提取数据 " & Format(Now, "hh:mm:ss")
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
End If
ElseIf cell.Value = ":END" Then
isCopying = False
ReDim Preserve arr(cnt - 1)
Sheets("点位提取").Range("C5").Resize(cnt, 1).Value = Application.Transpose(arr)
If Me.Range("AH34").Value = True Then
Me.ListBox1.AddItem "数据已进行提取完毕 " & Format(Now, "hh:mm:ss")
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
End If
Exit For
End If
If isCopying And cell.Value <> ":BEGIN" Then
arr(cnt) = rng.Cells(cell.Row, 1).Value
cnt = cnt + 1
End If
Next cell
If Target.Address = "$B$2" Then
For i = 9 To 40
For j = 2 To 7
If ws.Cells(i, j).Value = ws.Cells(8, 5).Value Then
For k = 3 To 4
ws.Cells(i, j + k - 2).Value = ws.Cells(Application.Match(ws.Cells(i, 1).Value, ws.Range("AK9:AK40"), 0) + 8, k).Value
Next k
End If
Next j
Next i
End If
End If
On Error GoTo ErrorHandler
Exit Sub
ErrorHandler:
If Me.Range("AH36").Value = True Then
Me.ListBox2.AddItem Err.Description & " " & Format(Now, "hh:mm:ss")
Me.ListBox2.ListIndex = Me.ListBox2.ListCount - 1
End If
End Sub
```