Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 16:39:00
ältere VBA Codes automatisch neu strukturieren
20.04.2024 16:36:42
Arbeitsblatt Script auslagern in Modul
20.04.2024 16:28:25
zwei Makro in einem zusammenführen?
20.04.2024 15:30:14
Warum Verweis zeigt Falsch an
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1020to1024
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1020to1024
1020to1024
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Codeerweiterung klappt nicht

Codeerweiterung klappt nicht
06.11.2008 13:50:00
Josef
Hallo!
Ich bekam heute dankenswerterweise folgenden Code, der auch bestens funktioniert:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrDaten
Dim raZelle As Range
If Intersect(Target, Columns("BF")) Is Nothing Then Exit Sub
Application.EnableEvents = False
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja", " _
Nein", "Ja", _
"eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection.Cells( _
_
1)  "" Then Selection.Offset(0, 17) = arrDaten(1)(Application.Match(Selection.Cells(1),  _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
Application.EnableEvents = True
Jetzt wollte ich diesen Code um eine weitere abfrage erweitern jedoch bekomme ich keijn  _
Ergebnis. Wo könnte ich hier bitte den Fehler gemacht haben?



Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrDaten
Dim raZelle As Range
If Intersect(Target, Columns("BF")) Is Nothing Then Exit Sub
Application.EnableEvents = False
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja", " _
Nein", "Ja", _
"eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection.Cells( _
_
1)  "" Then Selection.Offset(0, 17) = arrDaten(1)(Application.Match(Selection.Cells(1),  _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
Application.EnableEvents = True
Dim arrDaten1
Dim raZelle1 As Range
If Intersect(Target, Columns("BH")) Is Nothing Then Exit Sub
Application.EnableEvents = False
arrDaten1 = Array(Array("KOA 0", "KOA 20 %", "20% HB/HM"), Array("Kein Selbstbehalt", "20 %  _
mind. 20 % der HBG", "20 % mind. 20 % der HBG"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten1(0), 0)) And Selection. _
Cells( _
1)  "" Then Selection.Offset(0, 16) = arrDaten1(1)(Application.Match(Selection.Cells(1),  _
arrDaten1(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten1(0), 0)) And Target  "" Then Target.  _
_
Offset(0, 16) = arrDaten1(1)(Application.Match(Target, arrDaten1(0), 0) - 1)
End If
Application.EnableEvents = True
End Sub



Danke

Josef

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
weshalb neuer Thread?
06.11.2008 14:04:07
Beverly
Hi Josef,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrDaten
Application.EnableEvents = False
If Not Intersect(Target, Columns("BF")) Is Nothing Then
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja" _
, " Nein", "Ja", _
"eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And _
Selection.Cells(1)  "" Then Selection.Offset(0, 17) = arrDaten(1)(Application. _
Match(Selection.Cells(1), arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
_
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("BH")) Is Nothing Then
arrDaten = Array(Array("KOA 0", "KOA 20 %", "20% HB/HM"), Array("Kein Selbstbehalt", "20 % _
mind. 20 % der HBG", "20 % mind. 20 % der HBG"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1)  "" Then Selection.Offset(0, 16) = arrDaten(1)(Application.Match( _
Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
_
Offset(0, 16) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
End If
Application.EnableEvents = True
End Sub



Anzeige
AW: weshalb neuer Thread?
06.11.2008 14:20:00
Josef
Hallo Beverly!
Danke für Deine Antwort.
Nachdem ich den alten Thread geschlossen hatte, machte ich diesen auf. Werde in Zukunft besser aufpassen.
Ich bekomme die Fehler Meldung else ohne If
und diese Zeile wird markiert:
ElseIf Not Intersect(Target, Columns("BH")) Is Nothing Then
Danke
AW: weshalb neuer Thread?
06.11.2008 14:36:00
Beverly
Hi Phil,
da hast du sicher die Zeilenumbrüche aus dem Code hier im Forum nicht richtig übernommen - bei mir kommt keine Fehlermeldung.
https://www.herber.de/bbs/user/56561.xls

Anzeige
AW: weshalb neuer Thread?
06.11.2008 14:47:00
Josef
Hallo Beverly!
Danke, jetzt funktioniert es.
Josef
AW: weshalb neuer Thread?
07.11.2008 06:42:00
Josef
Guten Morgen Beverly!
Ich habe jetzt wieder eine Erweiterung drangehängt. nur leider erfolgt hier wieder kein Eintrag.
Wo mache ich hier bitte immer wieder den Fehler damit ich diesen in Zukunft verhindern kann?
Dim arrDaten
Application.EnableEvents = False
If Not Intersect(Target, Columns("BF")) Is Nothing Then
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja", "Nein", "Ja", _
"eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And _
Selection.Cells(1) <> "" Then Selection.Offset(0, 17) = arrDaten(1)(Application.Match(Selection.Cells(1), arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("BH")) Is Nothing Then
arrDaten = Array(Array("KOA 0", "KOA 20 %", "20% HB/HM"), Array("Kein Selbstbehalt", "20 % mind. 20 % der HBG", "20 % mind. 20 % der HBG"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1) <> "" Then Selection.Offset(0, 16) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 16) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("AG")) Is Nothing Then
arrDaten = Array(Array("401", "402", "403", "404", "405", "411", "412", "413", "414", "421", "431", "432", "433", "434", "435"), _
Array("KL 35/Zeile 3 Maßschuhe einschließlich Sonderarbeiten am Schuh", "KL 35/Zeile 4 Orthopädische Schuheinlagen", _
"KL 35/Zeile 5 Zurichtungen am Konfektionsschuh", "KL 35/Zeile 6 Chirurgische Bandagen", "KL 35/Zeile 7 sonstiges", _
"KL 35/Zeile 9 Gläser ohne Brillenfassung", "KL 35/Zeile 10 Gläser mit Brillenfassung", "KL 35/Zeile 11 Kontaktlinsen", "KL 35/Zeile 12 Sonstiges", _
"Heilbehelfe gem. § 137 Abs.3 ASVG, § 65 Abs.3 B-KUVG, § 93 Abs.3 GSVG, § 87 Abs.3 BSVG", _
"KL 35/Zeile 15 Hörgeräte", "KL 35/Zeile 16 Sprechgeräte", "KL 35/Zeile 17 Körperersatzstücke", _
"KL 35/Zeile 18 Krankenfahrstühle", "KL 35/Zeile 19 Sonstiges"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1) <> "" Then Selection.Offset(0, 44) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 44) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
End If
Application.EnableEvents = True
Danke Josef
Anzeige
AW: weshalb neuer Thread?
07.11.2008 06:46:06
Josef
Hallo nochmals!
Ich habe gerade bemerkt, bei einer Texteingabe geht es bei einer Zahleneingabe nicht.
wo müßte ich bitte hier den Code noch verändern?
Josef
AW: weshalb neuer Thread?
07.11.2008 07:10:49
Beverly
Hi Josef,
die Zahlen dürfen nicht in "" geschrieben werden da sie sonst als Text interpretier werden.

AW: weshalb neuer Thread?
07.11.2008 09:18:13
Josef
Hallo!
Besten Dank
Josef
AW: weshalb neuer Thread?
07.11.2008 11:00:00
Josef
Hallo Beverly!
Ich wollte mit dem Abfragen in der Spalte "AG" zwei Einträge in verschiedenen Spalten eintragen lassen.
Ist hier unter Umständen nur eine gewisse anzahl von ElseIf möglich?
Siehe inaktivierten Teil:
Dim arrDaten
Application.EnableEvents = False
If Not Intersect(Target, Columns("BF")) Is Nothing Then
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja", "Nein", "Ja", _
"eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And _
Selection.Cells(1) <> "" Then Selection.Offset(0, 17) = arrDaten(1)(Application.Match(Selection.Cells(1), arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("BH")) Is Nothing Then
arrDaten = Array(Array("KOA 0", "KOA 20 %", "20% HB/HM"), Array("Kein Selbstbehalt", "20 % mind. 20 % der HBG", "20 % mind. 20 % der HBG"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1) <> "" Then Selection.Offset(0, 16) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 16) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("AG")) Is Nothing Then
arrDaten = Array(Array("401", "402", "403", "404", "405", "411", "412", "413", "414", "421", "431", "432", "433", "434", "435"), _
Array("KL 35/Zeile 3 Maßschuhe einschließlich Sonderarbeiten am Schuh", "KL 35/Zeile 4 Orthopädische Schuheinlagen", _
"KL 35/Zeile 5 Zurichtungen am Konfektionsschuh", "KL 35/Zeile 6 Chirurgische Bandagen", "KL 35/Zeile 7 sonstiges", _
"KL 35/Zeile 9 Gläser ohne Brillenfassung", "KL 35/Zeile 10 Gläser mit Brillenfassung", "KL 35/Zeile 11 Kontaktlinsen", "KL 35/Zeile 12 Sonstiges", _
"Heilbehelfe gem. § 137 Abs.3 ASVG, § 65 Abs.3 B-KUVG, § 93 Abs.3 GSVG, § 87 Abs.3 BSVG", _
"KL 35/Zeile 15 Hörgeräte", "KL 35/Zeile 16 Sprechgeräte", "KL 35/Zeile 17 Körperersatzstücke", _
"KL 35/Zeile 18 Krankenfahrstühle", "KL 35/Zeile 19 Sonstiges"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1) <> "" Then Selection.Offset(0, 45) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 45) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
'ElseIf Not Intersect(Target, Columns("AG")) Is Nothing Then
' arrDaten = Array(Array(411, "412", "413", "414", "431"), _
' Array("Augenoptiker", "Augenoptiker", _
' "Augenoptiker, Augenfachärzte mit Kontaktlinsenabgabeberechtigung", "Augenoptiker", "Hörgeräteakustiker"))
' If Target.Count > 1 Then
' If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
' Cells(1) <> "" Then Selection.Offset(0, 48) = arrDaten(1)(Application.Match(Selection.Cells(1), _
' arrDaten(0), 0) - 1)
' Else
' If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
' Offset(0, 48) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
' End If
ElseIf Not Intersect(Target, Columns("G")) Is Nothing Then
arrDaten = Array(Array("I Anlage 1 - Schuheinlagen", "II Anlage 2 - Arm- und Beinprothesen", _
"III Anlage 3 - Bandagen und Orthesen", "III Anlage 3 - Reparatur Bandagen", _
"III Anlage 3 - Reparatur Orthesen", "III Anlage 3 - Reparatur Regiestunde", _
"IV Anlage 4 - Elastische Binden", "IV Anlage 4 - Kompressionsbandagen", _
"V Anlage 5 - Colo-, Ileo-, Urostomie Versorgung", "V Anlage 5 - Sonstige", _
"VI Anlage 6 - Regiestunde"), _
Array("Orthopädietechniker", "Orthopädietechniker", "Orthopädietechniker", _
"Orthopädietechniker", "Orthopädietechniker", "Orthopädietechniker", _
"Orthopädietechniker", "Orthopädietechniker", "Orthopädietechniker", _
"Orthopädietechniker", "Orthopädietechniker"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1) <> "" Then Selection.Offset(0, 74) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target <> "" Then Target. _
Offset(0, 74) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
End If
Application.EnableEvents = True
Danke
Anzeige
AW: weshalb neuer Thread?
07.11.2008 11:59:28
Beverly
Hi Josef,
wenn du aus einer Spalte mehrere Zellen befüllen willst und das mit unterschiedlichen Werten, dann musst du das in der selben ElseIf Anweisung machen und anstelle des 2-dimensionalen Arrays ein 3-dimensionales verwenden, so nach folgendem Prinzip:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrDaten
Application.EnableEvents = False
If Target.Column = 1 Then
arrDaten = Array(Array("A", "B", "C"), Array(1, 2, 3))
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 2) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
ElseIf Target.Column = 2 Then
arrDaten = Array(Array("AA", "BB", "CC", "DD", "EE", "FF"), Array(1, 2, 3, 4, 5, 6),  _
Array("", "", "", 100, 200, 300))
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then
Target.Offset(0, 2) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
If arrDaten(2)(Application.Match(Target, arrDaten(0), 0) - 1)  "" Then Target.Offset( _
0, 4) = arrDaten(2)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
End If
Application.EnableEvents = True
End Sub


Für den letzten Fall in deinem Code, dass nur ein und der selbe Eintrag erfolgen soll, brauchst du übrigens kein 2-dimensionales Array, da reicht ewnn du den Wert direkt übergibst (ungetestet):


ElseIf Not Intersect(Target, Columns("G")) Is Nothing Then
arrDaten = Array("I Anlage 1 - Schuheinlagen", "II Anlage 2 - Arm- und Beinprothesen", _
"III Anlage 3 - Bandagen und Orthesen", "III Anlage 3 - Reparatur Bandagen", _
"III Anlage 3 - Reparatur Orthesen", "III Anlage 3 - Reparatur Regiestunde", _
"IV Anlage 4 - Elastische Binden", "IV Anlage 4 - Kompressionsbandagen", _
"V Anlage 5 - Colo-, Ileo-, Urostomie Versorgung", "V Anlage 5 - Sonstige", _
"VI Anlage 6 - Regiestunde")
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1)  "" Then Selection.Offset(0, 74) = "Orthopädietechniker"
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 74) = "Orthopädietechniker"
End If
End If


Hinweis: im Antwortformular gibt es den Schalter "Zitat". Wenn du deinen in den Beitrag eingefügten Code markierst und dann diesen Schalter drückst, wird der Code, wenn er mit Einrückungen formatiert ist, auch formatiert dargestellt. Auf diese Weise ist der Code wesentlich übersichtlicher und besser lesbar.


Anzeige
AW: weshalb neuer Thread?
07.11.2008 12:44:58
Josef
Hallo!
Danke nochmals für Deine Antwort.
Das Ganze jetzt auf meinen Fall umzulegen ist für mich leider ziemlich verwirrend.
So wie ich sehe, wäre praktisch das ganze nur mit der Eingabe des Wertes möglich nicht mehr mit dem Kopieren so wie es vorher der Fall war.
Josef
AW: weshalb neuer Thread?
07.11.2008 12:51:54
Josef
Hallo nochmals:
Ich habe gerade den letzten Code von dir in einer Arbeitsmappe getestet.
Mein vorhaben wäre jedoch folgendes gewesen:
Z.B. Eingabe der Zahl 411 in der Spalte AG
Ergebnis in der Spalte "BZ" "KL 35/Zeile 9 Gläser ohne Brillenfassung"
Ergebnis in der spalte "CC" "Orthopädietechniker"
also eine Eingabe = 2 Ergebnisse
Josef
Anzeige
AW: weshalb neuer Thread?
07.11.2008 14:03:00
Beverly
Hi Josef,
also wenn ich deinen Code richtig verstanden habe, dann soll bei Eintrag von "401" in Spalte AG in die Spalte BZ "KL 35/Zeile 9 Gläser ohne Brillenfassung" eingetragen werden und in Spalte CC nichts. Bei Eintrag von "412" in Spalte AG soll in BZ "KL 35/Zeile 10 Gläser mit Brillenfassung" und in CC "Augenoptiker" eingetragen werden.
Bei Eintrag in Spalte G soll in CC "Orthopädietechniker" eingetragen werden.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrDaten
Application.EnableEvents = False
If Not Intersect(Target, Columns("BF")) Is Nothing Then
arrDaten = Array(Array("J", "N", "J-xPV", "CHA/xPV", "EV-N / FV-XPV", "I-J/N"), Array("Ja" _
, "Nein", "Ja", "eventuell", "eventuell", "eventuell"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1)  "" Then Selection.Offset(0, 17) = arrDaten(1)(Application.Match(Selection.Cells(1), arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 17) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("BH")) Is Nothing Then
arrDaten = Array(Array("KOA 0", "KOA 20 %", "20% HB/HM"), Array("Kein Selbstbehalt", "20 % _
mind. 20 % der HBG", "20 % mind. 20 % der HBG"))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1)  "" Then Selection.Offset(0, 16) = arrDaten(1)(Application.Match(Selection.Cells(1), arrDaten(0), 0) - 1)
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then Target. _
Offset(0, 16) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
ElseIf Not Intersect(Target, Columns("AG")) Is Nothing Then
arrDaten = Array(Array("401", "402", "403", "404", "405", "411", "412", "413", "414", " _
421", "431", "432", "433", "434", "435"), Array("KL 35/Zeile 3 Maßschuhe einschließlich Sonderarbeiten am Schuh", _
"KL 35/Zeile 4 Orthopädische Schuheinlagen", "KL 35/Zeile 5 Zurichtungen am  _
Konfektionsschuh", "KL 35/Zeile 6 Chirurgische Bandagen", "KL 35/Zeile 7 sonstiges", _
"KL 35/Zeile 9 Gläser ohne Brillenfassung", "KL 35/Zeile 10 Gläser mit Brillenfassung", _
"KL 35/Zeile 11 Kontaktlinsen", "KL 35/Zeile 12 Sonstiges", _
"Heilbehelfe gem. § 137 Abs.3 ASVG, § 65 Abs.3 B-KUVG, § 93 Abs.3 GSVG, § 87 Abs.3  _
BSVG", _
"KL 35/Zeile 15 Hörgeräte", "KL 35/Zeile 16 Sprechgeräte", "KL 35/Zeile 17 Kö _
rperersatzstücke", _
"KL 35/Zeile 18 Krankenfahrstühle", "KL 35/Zeile 19 Sonstiges"), Array("", "", "", "",  _
"", "Augenoptiker", "Augenoptiker", _
"Augenoptiker, Augenfachärzte mit Kontaktlinsenabgabeberechtigung", "Augenoptiker", "Hö _
rgeräteakustiker", "", "", "", ""))
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten(0), 0)) And Selection. _
Cells(1)  "" Then
Selection.Offset(0, 45) = arrDaten(1)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
Selection.Offset(0, 48) = arrDaten(2)(Application.Match(Selection.Cells(1), _
arrDaten(0), 0) - 1)
End If
Else
If Not IsError(Application.Match(Target, arrDaten(0), 0)) And Target  "" Then
Target.Offset(0, 45) = arrDaten(1)(Application.Match(Target, arrDaten(0), 0) - 1)
Target.Offset(0, 48) = arrDaten(2)(Application.Match(Target, arrDaten(0), 0) - 1)
End If
End If
ElseIf Not Intersect(Target, Columns("G")) Is Nothing Then
arrDaten = Array("I Anlage 1 - Schuheinlagen", "II Anlage 2 - Arm- und Beinprothesen", _
"III Anlage 3 - Bandagen und Orthesen", "III Anlage 3 - Reparatur Bandagen", _
"III Anlage 3 - Reparatur Orthesen", "III Anlage 3 - Reparatur Regiestunde", _
"IV Anlage 4 - Elastische Binden", "IV Anlage 4 - Kompressionsbandagen", _
"V Anlage 5 - Colo-, Ileo-, Urostomie Versorgung", "V Anlage 5 - Sonstige", _
"VI Anlage 6 - Regiestunde")
If Target.Count > 1 Then
If Not IsError(Application.Match(Selection.Cells(1), arrDaten, 0)) And Selection. _
Cells(1)  "" Then Selection.Offset(0, 74) = "Orthopädietechniker"
Else
If Not IsError(Application.Match(Target, arrDaten, 0)) And Target  "" Then Target. _
Offset(0, 74) = "Orthopädietechniker"
End If
End If
Application.EnableEvents = True
End Sub



Anzeige
AW: weshalb neuer Thread?
07.11.2008 15:09:00
Josef
Hallo Beverly!
Danke für Deine Antwort. Ich bin jetzt leider schon zu Hause. Habe es auf Excel 2007 getestet. Da geht nichts. Ich nehme mal an dass das nur auf Excel 2003 funktioniert. Ich werde es am Montag in der Früh gleich testen und mich wieder melden. Ich hoffe dass der Thread am Montag noch vorhanden ist.
Josef
AW: weshalb neuer Thread?
07.11.2008 16:06:47
Beverly
Hi Josef,
der Code ist nicht abhängig von der Excel-Version, du musst aber einige Zeilenumbrüche, die durch die Forumssoftware erstellt wurden, wieder rückgängig machen. Außerdem musst du beachten, dass die Ziffern 401, 402 usw. in deinem Code als Text eingetragen sind. Es wird also erwartet, dass die betreffenden Zellen im Tabellenblatt ebenfalls als Text formatiert sind. Falls die Zellen doch als Standard formatiert sind, musst du die Anführungsstriche im Code weglassen.
https://www.herber.de/bbs/user/56608.xlsm

Anzeige
AW: weshalb neuer Thread?
10.11.2008 10:47:00
Josef
Hallo Beverly!
Habe jetzt den VBA Code mit Deiner lösung erweitert und es hat geklappt.
Danke für Deine Mühe.
Josef
erledigt
10.11.2008 11:44:07
zu
zu

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige