#excel #vba
#excel #vba
Вопрос:
Привет, команда, пожалуйста, кто-нибудь может мне помочь, когда я использую этот код на своем листе
Option Explicit
Private Sub ComboBox1_GotFocus()
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If
End Sub
** Это работает отлично, я не получаю никаких ошибок или сообщений,
и когда я использую этот код отдельно на своем листе**
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range, m, v
Dim rngCell1 As Range, m1, v1
Check1:
If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
For Each rngCell In Range("B19:B38")
v = rngCell.Value
If Len(v) > 0 Then
'See if the value is in your lookup table
m = Application.VLookup(v, _
ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)
'If found a match then replace wiht the vlookup result
If Not IsError(m) Then rngCell.Value = m
End If
Next
Exit Sub
Check2:
If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub
For Each rngCell1 In Range("A6,D6")
v1 = rngCell1.Value
If Len(v1) > 0 Then
'See if the value is in your lookup table
m1 = Application.VLookup(v1, _
ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)
'If found a match then replace wiht the vlookup result
If Not IsError(m1) Then rngCell1.Value = m1
End If
Next
On Error GoTo Hell
If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
Range("B14:B23").Value = ""
End If
Hell:
End Sub
**это также отлично работает. Я никогда не сталкиваюсь с какими-либо проблемами или ошибками. но когда я использую оба кода на своем листе, это выдает ошибку из-за двух
Private Sub Worksheet_Change (ByVal Target как диапазон)
пожалуйста, помогите мне.
как объединить этот код в один.**
Ответ №1:
Это потому, что вы не можете использовать одно и то же вложенное имя дважды. Однако вы можете скопировать содержимое одного из них перед содержимым другого подраздела. Затем они выполняются друг за другом.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If
On Error Goto 0
Dim rngCell As Range, m, v
Dim rngCell1 As Range, m1, v1
Check1:
If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
For Each rngCell In Range("B19:B38")
v = rngCell.Value
If Len(v) > 0 Then
'See if the value is in your lookup table
m = Application.VLookup(v, _
ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)
'If found a match then replace wiht the vlookup result
If Not IsError(m) Then rngCell.Value = m
End If
Next
Exit Sub
Check2:
If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub
For Each rngCell1 In Range("A6,D6")
v1 = rngCell1.Value
If Len(v1) > 0 Then
'See if the value is in your lookup table
m1 = Application.VLookup(v1, _
ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)
'If found a match then replace wiht the vlookup result
If Not IsError(m1) Then rngCell1.Value = m1
End If
Next
On Error GoTo Hell
If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
Range("B14:B23").Value = ""
End If
Hell:
End Sub
Комментарии:
1. Отлично, сэр, без сомнения, вы гений, мистер Ниростар.
2. Отлично, сэр, без сомнения, вы гений, мистер Ниростар.
3. @SandhuWheels Я рад, что смог помочь. Можете ли вы, пожалуйста, принять ответ тогда?
4. @SandhuWheels Если мой ответ вам помог, вы должны принять его как ответ.