तो वीबीए के लिए नया, लगभग यह काम कर रहा है। मैं कुछ डेटा सत्यापन सूचियों को रीसेट करने का प्रयास कर रहा हूं ताकि यदि कोई देश चयन बदलता है, तो कुछ कक्ष रीसेट हो जाएंगे। उदाहरण, यदि मैं यूएसए चुनता हूं तो मैं संबंधित राज्य और शिफ्ट कॉलम को "कृपया चुनें ..." प्रदर्शित करना चाहता हूं और यदि उपयोगकर्ता यूएसए के अलावा किसी अन्य देश में देश बदलता है तो यह राज्य कॉलम में कुछ भी नहीं कहता है, केवल में शिफ्ट कॉलम। मुझे यह काम मिल गया लेकिन यह केवल पहली पंक्ति के लिए चलता है। मुझे यकीन नहीं है कि मेरी सीमा गलत है या अगर मुझे लूप करना है, तो मैं पूरी तरह से अनजान हूं।

Option Explicit

'The way this works is if the Payroll Country changes then the sub selections
'of State and Shift should reset based on if the country is USA

'Payroll Country = A column
'State = X column
'Shift = Y column

Private Sub Worksheet_Change(ByVal Target As Range)

    '"If Target.Count > 1 Then Exit Sub" is the VBA code to prevent an error if user highlights the range and deletes the data
    If Target.Count > 1 Then Exit Sub


            If Target.Address = "$A$6" And Target.Value = "USA" Then
                Range("X6").Value = "Please select..."
                Range("Z6").Value = "Please select..."
       
            ElseIf Target.Address = "$A$6" And Target.Value <> "USA" Then
                Range("X6").Value = ""
                Range("Z6").Value = "Please select..."
        
            End If

End Sub
1
Edgar Nava 21 अगस्त 2021, 00:32

2 जवाब

सबसे बढ़िया उत्तर

ये कोशिश करें:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
    'check Target column and row...
    If Target.Column = 1 and Target.Row >= 6 Then 
        With Target.EntireRow
            .Columns("X").Value = IIf(Target.Value = "USA", _
                                     "Please select...", "")
            .Columns("Z").Value = "Please select..."
        End With
    End If
End Sub
0
Tim Williams 20 अगस्त 2021, 22:04

एक वर्कशीट चेंज

  • यदि आप लाइन Application.EnableEvents = False को आउट-टिप्पणी करते हैं, तो आप देखेंगे कि और अधिक Debug.Print लाइनें होंगी (USA के लिए एक और, non-USA के लिए दो और) यानी लिखने के बाद (crg.Value = InitialString), कोड खुद को कॉल करता है (वास्तव में वर्कशीट चेंज इवेंट InitializeCountry प्रक्रिया को कॉल करता है) लेकिन 'सौभाग्य से' लाइन If irg Is Nothing Then Exit Sub के बाद बाहर निकल जाता है क्योंकि यह एक गैर-प्रतिच्छेदन रेंज को लिख रहा है, लेकिन फिर भी Source Range Address को लाइन Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0) के साथ जारी रखने से पहले, एक बार फिर डिबग-प्रिंटिंग करें। इससे आपको पूरी तरह से समझने में मदद मिलनी चाहिए कि घटनाओं को अक्षम करना क्यों आवश्यक है।
  • परीक्षण पूरा होने पर संबंधित Debug.Print पंक्तियों से संबंधित श्रेणी पतों को आउट-टिप्पणी करें या हटाएं क्योंकि वे कोड को धीमा कर रहे हैं।

शीट मॉड्यूल उदा. Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    InitializeCountry Target
End Sub

मानक मॉड्यूल उदा. Module1

Option Explicit

Sub InitializeCountry( _
        ByVal Target As Range)
    
    ' Declare constants.
    
    Const SourceFirstCellAddress As String = "A6"
    Const StateColumn As String = "X"
    Const ShiftColumn As String = "Z"
    Const CriteriaString As String = "USA"
    Const InitialString As String = "Please select..."
    
    ' Read.
    
    Dim ws As Worksheet: Set ws = Target.Worksheet
    Dim sfCell As Range: Set sfCell = ws.Range(SourceFirstCellAddress)
    Dim srg As Range: Set srg = sfCell.Resize(ws.Rows.Count - sfCell.Row + 1)
    Debug.Print "Source Range Address:          " & srg.Address(0, 0)
        
    Dim irg As Range: Set irg = Intersect(srg, Target) ' Intersect Range
    If irg Is Nothing Then Exit Sub
    Debug.Print "Intersect Range Address:       " & irg.Address(0, 0)
    
    ' ShiftColumn
    Dim crg As Range ' Criteria Range
    Set crg = irg.EntireRow.Columns(ShiftColumn)
    Debug.Print "Criteria Range (ShiftColumn):  " & crg.Address(0, 0)
    
    ' StateColumn
    Dim erg As Range ' Empty Range
    Dim iCell As Range ' Current Intersect Cell
    For Each iCell In irg.Cells
        If iCell.Value = CriteriaString Then
            Set crg = Union(crg, iCell.EntireRow.Columns(StateColumn))
        Else
            If erg Is Nothing Then
                Set erg = iCell.EntireRow.Columns(StateColumn)
            Else
                Set erg = Union(erg, iCell.EntireRow.Columns(StateColumn))
            End If
        End If
    Next iCell
    
    ' Write.
    
    Application.ScreenUpdating = False
    ' This is crucial to not retrigger the event procedure when writing!
    Application.EnableEvents = False
    
    On Error GoTo ClearError
    
    crg.Value = InitialString
    Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0)
    
    If Not erg Is Nothing Then
        erg.ClearContents ' erg.Value = Empty
        Debug.Print "Empty Range (StateColumn):     " & erg.Address(0, 0)
    End If
    
SafeExit:

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Exit Sub
    
ClearError:
    ' Don't uncomment this line!
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit

End Sub


' Test multi-range (only possible with VBA).
Sub InitializeCountryTEST()
    Dim rg As Range: Set rg = Range("A6:A20,A31:A50,A61:A100")
    rg.Value = "USA"
End Sub

' Debug.Print result for 'USA' (no 'Empty Range'):
'Source Range Address:          A6:A1048576
'Intersect Range Address:       A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn):   Z6:Z20
'Criteria Range (Both Columns): Z6:Z20,X6:X20,X31:X50,X61:X100

' Debug.Print result otherwise:
'Source Range Address:          A6:A1048576
'Intersect Range Address:       A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn):   Z6:Z20
'Criteria Range (Both Columns): Z6:Z20
'Empty Range (StateColumn):     X6:X20,X31:X50,X61:X100
0
VBasic2008 21 अगस्त 2021, 04:00