Programmteil verkürzen

Hallo zusammen,
ich möchte einen Programmteil verkürzen. weis aber nicht wie!
Ich habe eine lange Tabelle in dem ich Zuweisungen durchführe. Hier ist für jede Spalte der nachfolgende Teil aufgeführt.
Range("A1").Select
ActiveWorkbook.Names.Add Name:="Dropdown_A", RefersToR1C1:= _
"=OFFSET(dr_dn!R10C1,0,0,COUNTA(dr_dn!C1))"
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Dropdown_A"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Im nächsten Schritt:
Range("B1").Select
ActiveWorkbook.Names.Add Name:="Dropdown_B", RefersToR1C1:= _
"=OFFSET(dr_dn!R10C2,0,0,COUNTA(dr_dn!C2))"
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Dropdown_B"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("C1").Select
ActiveWorkbook.Names.Add Name:="Dropdown_C", RefersToR1C1:= _
"=OFFSET(dr_dn!R10C3,0,0,COUNTA(dr_dn!C3))"
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Dropdown_C"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
usw.
Ist es möglch eine Schleife von Spalte A-X zu schreiben?
Gruß
Lemmi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub lemmi() Dim lngIndex As Long For lngIndex = 1 To 24 ActiveWorkbook.Names.Add Name:="Dropdown_" & Chr(lngIndex + 64), _ RefersToR1C1:="=OFFSET(dr_dn!R10C" & lngIndex & ",0,0,COUNTA(dr_dn!C" & lngIndex & "))" With Cells(1, lngIndex).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=Dropdown_" & Chr(lngIndex + 64) End With Next End Sub

Hallo Sepp,
leider hängt sich das Marko beim zweien Durchlauf auf und kann nur abgebrochen werden.
Darüberhinaus würde ich noch bis Spalte DX die Programmschleife erweitern.
Ich möchte Dir einmal den ganzen Code zeigen. Bestimmt kannst Du das besser!


Sub Update_Dropdown_Zuweisung()
' Es wird von dem Arbeitsblatt dr_dn (Dropdown)die Spalten einer beliebigen
' Tabellen automatisch zugewiesen --> selektierte Tabelle A1-AI
Range("A1").Select
'selektiert in der aktiven Arbeitsblatt die Zelle A1
ActiveWorkbook.Names.Add Name:="Dropdown_A", RefersToR1C1:= _
"=OFFSET(dr_dn!R10C1,0,0,COUNT(dr_dn!C1))"
'ActiveWorkbook.Names.Add Name:="Dropdown_A"-->
'fügt den Namen "Dropdown_A" hinzu
'"=OFFSET(dr_dn!R10C1,0,0,COUNT(dr_dn!C1))"-->
'verschiebt die referenz Dropdown Spalte auf das Arbeitsblatt "dr_dn"
'ab Zeile 10 und liest ab dort die gelisteten Zahlen und Texte aus
'Anzahl2: liest Texte und Zahlenwerte aus
'Anzahl : liest nur Zahlen aus
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Dropdown_A"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
SendKeys "{F4}"
' Prüft die Güligkeit der Daten:
' Daten; Gültigkeit; Gültigkeitprüfing; Liste ;Quelle
'"=Dropdown_A"--> Eintrag
Dim lngIndex As Long
For lngIndex = 1 To 24
ActiveWorkbook.Names.Add Name:="Dropdown_" & Chr(lngIndex + 64), _
RefersToR1C1:="=OFFSET(dr_dn!R10C" & lngIndex & ",0,0,COUNTA(dr_dn!C" & lngIndex & "))"
With Cells(1, lngIndex).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Dropdown_" & Chr(lngIndex + 64)
End With
Next
End
Range("A1").Select
End Sub

Gruß
Lemmi

Sub lemmi() Dim lngIndex As Long, strDD As String For lngIndex = 1 To 128 strDD = "Dropdown_" & Replace(Cells(1, lngIndex).Address(0, 0), "1", "") ActiveWorkbook.Names.Add Name:=strDD, _ RefersToR1C1:="=OFFSET(dr_dn!R10C" & lngIndex & ",0,0,COUNTA(dr_dn!C" & lngIndex & "))" With Cells(1, lngIndex).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=" & strDD End With Next End Sub

Sub lemmi() Dim lngIndex As Long, strDD As String For lngIndex = 1 To 128 If Application.CountA(Sheets("dr_dn").Cells(10, lngIndex).Resize(Rows.Count - 9)) > 0 Then strDD = "Dropdown_" & Replace(Cells(1, lngIndex).Address(0, 0), "1", "") ActiveWorkbook.Names.Add Name:=strDD, _ RefersToR1C1:="=OFFSET(dr_dn!R10C" & lngIndex & ",0,0,COUNTA(dr_dn!C" & lngIndex & "))" With ActiveSheet.Cells(1, lngIndex).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=" & strDD End With End If Next End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread