Me.ListBox1.AddItem
时间: 2024-06-13 17:07:41 浏览: 6
Me.ListBox1.AddItem是在Visual Basic中向ListBox控件添加新项的方法。它将新项添加到ListBox控件的末尾。下面是一个示例代码,演示如何使用Me.ListBox1.AddItem方法向ListBox控件添加新项:
```vb
Me.ListBox1.AddItem "New Item"
```
这将在ListBox控件的末尾添加一个名为"New Item"的新项。
相关问题
帮我合并以下宏程序 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
```
在以下宏中帮我把查找结果输出到对应的AL9-EG40单元格中 Option Explicit 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
可以将以下代码添加到宏的末尾,用于查找并输出结果:
Dim searchRange As Range
Dim searchValue As String
Dim resultCell As Range
'设置查找范围
Set searchRange = Sheets("点位提取").Range("C5:C200")
'获取查找值
searchValue = Me.Range("B1").Value
'查找匹配的单元格
Set resultCell = searchRange.Find(searchValue)
'如果找到了匹配的单元格,输出结果到对应的AL9-EG40单元格
If Not resultCell Is Nothing Then
Me.Range("AL" & (resultCell.Row + 3)).Value = resultCell.Offset(0, 1).Value
Me.Range("AM" & (resultCell.Row + 3)).Value = resultCell.Offset(0, 2).Value
Me.Range("AN" & (resultCell.Row + 3)).Value = resultCell.Offset(0, 3).Value
Me.Range("AO" & (resultCell.Row + 3)).Value = resultCell.Offset(0, 4).Value
End If
注意:这段代码需要放在整个宏的最后一个 End Sub 的后面。此外,还需要在代码中根据实际情况调整输出结果的单元格范围。
相关推荐
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![rar](https://img-home.csdnimg.cn/images/20210720083606.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![rar](https://img-home.csdnimg.cn/images/20210720083606.png)
![zip](https://img-home.csdnimg.cn/images/20210720083736.png)
![7z](https://img-home.csdnimg.cn/images/20210720083312.png)
![zip](https://img-home.csdnimg.cn/images/20210720083736.png)