Как использовать несколько частных вложенных листов_обмена (по умолчанию целевой как диапазон) на одном листе

#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 Если мой ответ вам помог, вы должны принять его как ответ.