请教一下大家

missyoua

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Worksheet.Name = "Sheet2" And Target.Column = 1 And Target.Row >= 3 And Target.Row <= 127 Then
        Dim searchValue As Variant
        searchValue = Target.value
        
        Dim sheet1 As Worksheet
        Set sheet1 = ThisWorkbook.Sheets("Sheet1")
        
        Dim foundRow As Long
        foundRow = 0
        Dim i As Long
        For i = 3 To 127
            If sheet1.Cells(i, 1).value = searchValue Then
                foundRow = i
                Exit For
            End If
        Next i
        
        If foundRow > 0 Then
            Dim sourceRange As Range
            Set sourceRange = sheet1.Rows(foundRow)
            
            Dim destinationRange As Range
            Set destinationRange = Target.EntireRow
            
            Dim j As Long
            For j = 1 To sourceRange.Columns.Count
                Dim value As Variant
                value = sourceRange.Cells(1, j).value
                If IsNumeric(value) Then
                    If value = 0 Then
                        destinationRange.Cells(1, j).value = ""
                    Else
                        destinationRange.Cells(1, j).value = Val(value)
                    End If
                Else
                    destinationRange.Cells(1, j).value = value
                End If
            Next j
        End If
    End If
End Sub
请教一下大家为什么我使用这个VBA  会卡顿几秒呢  怎么才不卡

missyoua

超级烦 每次都会卡顿几秒

ynzsvt

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Worksheet.Name = "Sheet2" And Target.Column = 1 And Target.Row >= 3 And Target.Row <= 127 Then
   
3.   Dim searchValue As Variant
   
4.   searchValue = Target.value
   
5. 
   
6.   Dim sheet1 As Worksheet
   
7.   Set sheet1 = ThisWorkbook.Sheets("Sheet1")
   
8. 
   
9.   Dim foundRow As Long
   
10.   foundRow = 0
    
11.   Dim i As Long
    
12.   For i = 3 To 127
    
13.    If sheet1.Cells(i, 1).value = searchValue Then
    
14.     foundRow = i
    
15.     Exit For
    
16.    End If
    
17.   Next i
    
18. 
    
19.   If foundRow > 0 Then
    
20.    Dim sourceRange As Range
    
21.    Set sourceRange = sheet1.Rows(foundRow)
    
22. 
    
23.    Dim destinationRange As Range
    
24.    Set destinationRange = Target.EntireRow
    
25.    Application.EnableEvents = False
    
26. 
    
27.    Dim j As Long
    
28.    For j = 1 To sourceRange.Columns.Count
    
29.     Dim value As Variant
    
30.     value = sourceRange.Cells(1, j).value
    
31.     If IsNumeric(value) Then
    
32.      If value = 0 Then
    
33.       destinationRange.Cells(1, j).value = ""
    
34.      Else
    
35.       destinationRange.Cells(1, j).value = Val(value)
    
36.      End If
    
37.     Else
    
38.      destinationRange.Cells(1, j).value = value
    
39.     End If
    
40.    Next j
    
41.    Application.EnableEvents = True
    
42. 
    
43.   End If
    
44. End If
    
45. End Sub

复制代码

missyoua

ynzsvt 发表于 2024-9-15 08:12

牛逼   谢谢 赞

songshihai

Target.Worksheet.Name  这个确定没问题???target是单元格呃

醉眼看尘世

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim rG As Range, i&, j&
   
3. Application.EnableEvents = False
   
4.     If Target.Column = 1 And Target.Row >= 3 And Target.Row <= 127 Then
   
5.         Dim searchValue As Variant
   
6.         searchValue = Target.value
   
7.         Dim sheet1 As Worksheet
   
8.         Set sheet1 = ThisWorkbook.Sheets("Sheet1")
   
9.         searchValue = Target.value
   
10.         Target.EntireRow.ClearContents
    
11.         If searchValue <> "" Then
    
12.             Set rG = sheet1.[a3:a127].Find(searchValue)
    
13.     Dim sourceRange As Range
    
14.             Set sourceRange = sheet1.Rows(rG.Row)
    
15.             
    
16.             Dim destinationRange As Range
    
17.             Set destinationRange = Target.EntireRow
    
18.             If Not rG Is Nothing Then
    
19.                 For j = 1 To sourceRange.Columns.Count
    
20.                     value = sourceRange.Cells(1, j).value
    
21.                     If IsNumeric(value) Then
    
22.                         If value = 0 Then
    
23.                             destinationRange.Cells(1, j).value = ""
    
24.                         Else
    
25.                             destinationRange.Cells(1, j).value = Val(value)
    
26.                         End If
    
27.                     Else
    
28.                         destinationRange.Cells(1, j).value = value
    
29.                     End If
    
30.                 Next j
    
31.             End If
    
32.         End If
    
33.     End If
    
34. Application.EnableEvents = True
    
35. End Sub
    

复制代码

missyoua

醉眼看尘世 发表于 2024-9-15 09:36

谢谢.......

ykcbf1100

使用数组速度会快很多。

ww87725244

卡顿几秒就烦吗？我这登个系统得2分钟，要是查询某个历史数据那得10分钟以上