在以下宏中帮我把查找结果输出到对应的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

这段代码的作用是在 Excel 表格中，当 B1 单元格发生改变时，根据 B1:B2000 区域内的数据，提取以 ":BEGIN" 开始、":END" 结束的数据，并将其输出到点位提取工作表的 C5:C200 单元格中。如果 B2 单元格发生改变，则根据 AK9:AK40 区域中与 B2 单元格的值相匹配的单元格，将 AL9-EG40 区域中对应位置的值替换为该单元格的第三至四列的值。同时，如果 AH34 或 AH36 单元格的值为 True，则会在 ListBox1 和 ListBox2 控件中记录相应操作的时间和信息。

相关问题

Option Explicit Private Const c_sDialogCommand As String = "fDialog" Const sResourcePrefix As String = "RES_" Private Const c_sAddinFolder As String = "Analysis" Private Const c_sXllName As String = "ANALYS32.XLL" Private Enum RegistrationTerm RegistrationAddIn = 1 RegistrationFunction = 2 End Enum

这段代码是使用Visual Basic for Applications (VBA)编写的，主要包括一些常量、枚举类型和变量的定义。下面是每一行的解释：

- Option Explicit：启用严格的变量声明，要求在使用任何变量之前都必须声明它们的类型，以减少潜在的错误和代码中的混淆。
- Private Const c_sDialogCommand As String = "fDialog"：定义了一个私有常量c_sDialogCommand，类型为字符串，其值为"fDialog"。
- Const sResourcePrefix As String = "RES_"：定义了一个常量sResourcePrefix，类型为字符串，其值为"RES_"。
- Private Const c_sAddinFolder As String = "Analysis"：定义了一个私有常量c_sAddinFolder，类型为字符串，其值为"Analysis"。
- Private Const c_sXllName As String = "ANALYS32.XLL"：定义了一个私有常量c_sXllName，类型为字符串，其值为"ANALYS32.XLL"。
- Private Enum RegistrationTerm：定义了一个私有枚举类型RegistrationTerm。
- RegistrationAddIn = 1：定义了枚举成员RegistrationAddIn，其值为1。
- RegistrationFunction = 2：定义了枚举成员RegistrationFunction，其值为2。

vb6代码报错：Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer Private Const WM_APPCOMMAND As Integer = &H319 Private Const APPCOMMAND_VOLUME_UP As Integer = &HA Private Const APPCOMMAND_VOLUME_DOWN As Integer = &H9 Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H8 Private Sub IncreaseVolume() SendMessage(Me.Handle, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_UP * &H10000) End Sub Private Sub DecreaseVolume() SendMessage(Me.Handle, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_DOWN * &H10000) End Sub Private Sub MuteVolume() SendMessage(Me.Handle, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_MUTE * &H10000) End Sub

这段代码是使用 VB6 调用 Windows API 函数来控制系统音量的，但是在 64 位 Windows 上可能会出现问题。如果你在 64 位 Windows 上运行这段代码，可能会收到“找不到指定的DLL”的错误消息。

为了解决这个问题，你需要使用 PtrSafe 关键字来声明指针类型，以及使用 LongPtr 类型来代替 Long 类型。

修改后的代码如下：

Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Const WM_APPCOMMAND As Long = &H319
Private Const APPCOMMAND_VOLUME_UP As Long = &HA
Private Const APPCOMMAND_VOLUME_DOWN As Long = &H9
Private Const APPCOMMAND_VOLUME_MUTE As Long = &H8

Private Sub IncreaseVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_UP * &H10000
End Sub

Private Sub DecreaseVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_DOWN * &H10000
End Sub

Private Sub MuteVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_MUTE * &H10000
End Sub

注意，在使用 PtrSafe 关键字时，你需要在代码文件的开头添加 Option Explicit 和 #If Win64 Then ... #Else ... #End If 的指令。完整的代码如下：

Option Explicit

#If Win64 Then
Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

Private Const WM_APPCOMMAND As Long = &H319
Private Const APPCOMMAND_VOLUME_UP As Long = &HA
Private Const APPCOMMAND_VOLUME_DOWN As Long = &H9
Private Const APPCOMMAND_VOLUME_MUTE As Long = &H8

Private Sub IncreaseVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_UP * &H10000
End Sub

Private Sub DecreaseVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_DOWN * &H10000
End Sub

Private Sub MuteVolume()
SendMessage Me.hWnd, WM_APPCOMMAND, &H30292, APPCOMMAND_VOLUME_MUTE * &H10000
End Sub