Hilfe bei Code

Hallo Excelfreunde,
mein Beitrag ist unten raus und daher muss ich neu um Hilfe bitten.
So schaut mein Code aus aber es läuft noch nicht rund. Es sollte egal ob ich in B3 oder C3 was wähle der Bereich geleert und dann gefüllt werden.
Dies habe ich derzeitig mit einer weiteren Zelle (D3) umgesetzt den Bereich zu leeren.
Hier mal meine Mappe.
https://www.herber.de/bbs/user/76365.xls
Mein Code.
Option Explicit
Public pubBolChanged As Boolean
Public pubLngCol As Long
Public pubLngRow As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Address(0, 0) = "D3" Then
Application.EnableEvents = False
Range("B5:D17").ClearContents
Application.EnableEvents = True
End If
If Target.Address = "$B$3" Then
ReadValues Target
ElseIf Target.Address = "$C$3" Then
If Target = "B" Then
ReadValues1 Target
ElseIf Target.Address = "$C$3" Then
If Target = "C" Then
ReadValues2 Target
ElseIf Target.Address = "$C$3" Then
If Target = "D" Then
ReadValues3 Target
ElseIf Target.Address = "$C$3" Then
If Target = "E" Then
ReadValues4 Target
End If
End If
End If
End If
End If
End Sub

Sub ReadValues(rngTarget As Range)
pubLngCol = WorksheetFunction.Match(rngTarget, Sheet2.Rows(3), 0)
Application.ScreenUpdating = False
Cells(5, 2) = Sheet2.Cells(4, pubLngCol)
Cells(6, 2) = Sheet2.Cells(5, pubLngCol)
Cells(7, 2) = Sheet2.Cells(6, pubLngCol)
Cells(8, 2) = Sheet2.Cells(7, pubLngCol)
Cells(9, 2) = Sheet2.Cells(8, pubLngCol)
Cells(10, 2) = Sheet2.Cells(9, pubLngCol)
Cells(11, 2) = Sheet2.Cells(10, pubLngCol)
Cells(12, 2) = Sheet2.Cells(11, pubLngCol)
Cells(13, 2) = Sheet2.Cells(12, pubLngCol)
Cells(5, 4) = Sheet2.Cells(13, pubLngCol)
Cells(6, 4) = Sheet2.Cells(14, pubLngCol)
Cells(7, 4) = Sheet2.Cells(15, pubLngCol)
Cells(8, 4) = Sheet2.Cells(16, pubLngCol)
Cells(9, 3) = Sheet2.Cells(17, pubLngCol)
Application.ScreenUpdating = True
End Sub Sub ReadValues1(rngTarget As Range)
pubLngCol = WorksheetFunction.Match(rngTarget, Sheet2.Rows(31), 0)
Application.ScreenUpdating = False
Cells(5, 2) = Sheet2.Cells(32, pubLngCol)
Cells(6, 2) = Sheet2.Cells(33, pubLngCol)
Cells(7, 2) = Sheet2.Cells(34, pubLngCol)
Cells(8, 2) = Sheet2.Cells(35, pubLngCol)
Cells(9, 2) = Sheet2.Cells(36, pubLngCol)
Cells(10, 2) = Sheet2.Cells(37, pubLngCol)
Cells(11, 2) = Sheet2.Cells(38, pubLngCol)
Cells(12, 2) = Sheet2.Cells(39, pubLngCol)
Cells(13, 2) = Sheet2.Cells(40, pubLngCol)
Cells(5, 4) = Sheet2.Cells(41, pubLngCol)
Cells(6, 4) = Sheet2.Cells(42, pubLngCol)
Cells(7, 4) = Sheet2.Cells(43, pubLngCol)
Cells(8, 4) = Sheet2.Cells(44, pubLngCol)
Cells(9, 3) = Sheet2.Cells(45, pubLngCol)
Application.ScreenUpdating = True
End Sub
Sub ReadValues2(rngTarget As Range)
pubLngCol = WorksheetFunction.Match(rngTarget, Sheet2.Rows(51), 0)
Application.ScreenUpdating = False
Cells(5, 2) = Sheet2.Cells(52, pubLngCol)
Cells(6, 2) = Sheet2.Cells(53, pubLngCol)
Cells(7, 2) = Sheet2.Cells(54, pubLngCol)
Cells(8, 2) = Sheet2.Cells(55, pubLngCol)
Cells(9, 2) = Sheet2.Cells(56, pubLngCol)
Cells(10, 2) = Sheet2.Cells(57, pubLngCol)
Cells(11, 2) = Sheet2.Cells(58, pubLngCol)
Cells(12, 2) = Sheet2.Cells(59, pubLngCol)
Cells(13, 2) = Sheet2.Cells(60, pubLngCol)
Cells(5, 4) = Sheet2.Cells(61, pubLngCol)
Cells(6, 4) = Sheet2.Cells(62, pubLngCol)
Cells(7, 4) = Sheet2.Cells(63, pubLngCol)
Cells(8, 4) = Sheet2.Cells(64, pubLngCol)
Cells(9, 3) = Sheet2.Cells(65, pubLngCol)
Application.ScreenUpdating = True
End Sub
Sub ReadValues3(rngTarget As Range)
pubLngCol = WorksheetFunction.Match(rngTarget, Sheet2.Rows(71), 0)
Application.ScreenUpdating = False
Cells(5, 2) = Sheet2.Cells(72, pubLngCol)
Cells(6, 2) = Sheet2.Cells(73, pubLngCol)
Cells(7, 2) = Sheet2.Cells(74, pubLngCol)
Cells(8, 2) = Sheet2.Cells(75, pubLngCol)
Cells(9, 2) = Sheet2.Cells(76, pubLngCol)
Cells(10, 3) = Sheet2.Cells(77, pubLngCol)
Cells(11, 3) = Sheet2.Cells(78, pubLngCol)
Cells(12, 3) = Sheet2.Cells(79, pubLngCol)
Cells(13, 3) = Sheet2.Cells(80, pubLngCol)
Cells(5, 4) = Sheet2.Cells(81, pubLngCol)
Cells(6, 4) = Sheet2.Cells(82, pubLngCol)
Cells(7, 4) = Sheet2.Cells(83, pubLngCol)
Cells(8, 4) = Sheet2.Cells(84, pubLngCol)
Cells(9, 3) = Sheet2.Cells(85, pubLngCol)
Application.ScreenUpdating = True
End Sub
Sub ReadValues4(rngTarget As Range)
pubLngCol = WorksheetFunction.Match(rngTarget, Sheet2.Rows(89), 0)
Application.ScreenUpdating = False
Cells(5, 2) = Sheet2.Cells(90, pubLngCol)
Cells(6, 2) = Sheet2.Cells(91, pubLngCol)
Cells(7, 2) = Sheet2.Cells(92, pubLngCol)
Cells(8, 2) = Sheet2.Cells(93, pubLngCol)
Cells(9, 2) = Sheet2.Cells(94, pubLngCol)
Cells(10, 2) = Sheet2.Cells(95, pubLngCol)
Cells(11, 2) = Sheet2.Cells(96, pubLngCol)
Cells(12, 2) = Sheet2.Cells(97, pubLngCol)
Cells(13, 2) = Sheet2.Cells(98, pubLngCol)
Cells(5, 4) = Sheet2.Cells(99, pubLngCol)
Cells(6, 4) = Sheet2.Cells(100, pubLngCol)
Cells(7, 4) = Sheet2.Cells(101, pubLngCol)
Cells(8, 4) = Sheet2.Cells(102, pubLngCol)
Cells(9, 3) = Sheet2.Cells(103, pubLngCol)
Application.ScreenUpdating = True
End Sub Tabelle1

	A	B	C	D	E
1
2		Werte aus jeweiliger Spalte	aus jeweiligem Bereich
3		2009	E	0
4
5	Name1				< Bereich leeren und dann füllen wenn in B3 oder C3 was passiert
6	Name2
7	Name3
8	Name4
9	Name5
10	Name6
11	Name7
12	Name8
13	Name9
14	Name10
15	Name11
16	Name12
17	Name13
18	usw.
19

Daten, Gültigkeit
Zelle	Zulassen	Daten	Wert1	Wert2	Leere Zellen ignorieren	Zellendropdown	Titel Eingabemeldung	Eingabemeldung	Titel Fehler	Fehlermeldung
B3	Liste		2009;2010;2011;2012;2013;		Wahr	Wahr
C3	Liste		A;B;C;D;E;		Wahr	Wahr
D3	Liste		0;		Wahr	Wahr

Tabelle2

	A	B	C	D	E	F
6	Name3	Text 3	Text 4	Text 5	Text 6	Text 7
28	Name25	Text 25	Text 26	Text 27	Text 28	Text 29
29	Name26	Text 26	Text 27	Text 28	Text 29	Text 30
30	Name27	Text 27	Text 28	Text 29	Text 30	Text 31
31		B
32	Name1B	Text B1	Text B2	Text B3	Text B4	Text B5w
33	Name2B	Text B2	Text B3	Text B4	Text B5h	Text B6
48	Name17	Text B17	Text B18	Text B19	Text B20	Text B21
49	Name18	Text B18	Text B19	Text B20	Text B21	Text B22
50	Name19	Text B19	Text B20	Text B21	Text B22	Text B23
51		C
52	Name 1C	Text C1	Text C2	Text C3	Text C4	Text C5
53	Name 2C	Text C2	Text C3	Text C4	Text C5	Text C6
67	Name 16C	Text C16	Text C17	Text C18	Text C19	Text C20
68	Name 17C	Text C17	Text C18	Text C19	Text C20	Text C21
69	Name 18C	Text C18	Text C19	Text C20	Text C21	Text C22
70	Name 19C	Text C19	Text C20	Text C21	Text C22	Text C23
71		D
72	NameD1	1	2	3
73	NameD2	2	3	4
86	NameD15	15	16	17
87	NameD16	16	17	18
88	NameD17	17	18	19
89		E
90	NameE1	10	20	30
91	NameE2	20	30	40
109	NameE20	200	210	220
110	NameE21	210	220	230

verwendete Formeln
Zelle	Formel	Bereich
B31	=WENN(Tabelle1!$B$3=2009;"B";"")
C31	=WENN(Tabelle1!$B$3=2010;"B";"")
D31	=WENN(Tabelle1!$B$3=2011;"B";"")
E31	=WENN(Tabelle1!$B$3=2012;"B";"")
F31	=WENN(Tabelle1!$B$3=2013;"B";"")
B51	=WENN(Tabelle1!$B$3=2009;"C";"")
C51	=WENN(Tabelle1!$B$3=2010;"C";"")
D51	=WENN(Tabelle1!$B$3=2011;"C";"")
E51	=WENN(Tabelle1!$B$3=2012;"C";"")
F51	=WENN(Tabelle1!$B$3=2013;"C";"")
B71	=WENN(Tabelle1!$B$3=2009;"D";"")
C71	=WENN(Tabelle1!$B$3=2010;"D";"")
D71	=WENN(Tabelle1!$B$3=2011;"D";"")
E71	=WENN(Tabelle1!$B$3=2012;"D";"")
F71	=WENN(Tabelle1!$B$3=2013;"D";"")
B89	=WENN(Tabelle1!$B$3=2009;"E";"")
C89	=WENN(Tabelle1!$B$3=2010;"E";"")
D89	=WENN(Tabelle1!$B$3=2011;"E";"")
E89	=WENN(Tabelle1!$B$3=2012;"E";"")
F89	=WENN(Tabelle1!$B$3=2013;"E";"")

Tabellendarstellung in Foren Version 5.37

Ich hoffe es kann mir jemand helfen.
Gruß Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Cells(5, 2) = .Cells(varRow, varCol) Cells(6, 2) = .Cells(varRow + 1, varCol) Cells(7, 2) = .Cells(varRow + 2, varCol) Cells(8, 2) = .Cells(varRow + 3, varCol) Cells(9, 2) = .Cells(varRow + 4, varCol) Cells(10, 2) = .Cells(varRow + 5, varCol) Cells(11, 2) = .Cells(varRow + 6, varCol) Cells(12, 2) = .Cells(varRow + 7, varCol) Cells(13, 2) = .Cells(varRow + 8, varCol) Cells(5, 4) = .Cells(varRow + 9, varCol) Cells(6, 4) = .Cells(varRow + 10, varCol) Cells(7, 4) = .Cells(varRow + 11, varCol) Cells(8, 4) = .Cells(varRow + 12, varCol) Cells(9, 3) = .Cells(varRow + 13, varCol)

Hallo Tino,
bei A,B und C sind die Zellen wohin der Wert übertragen wird gleich nur in D und E sind sie verschieden
Cells(5, 2) = .Cells(varRow, varCol)
Cells(6, 2) = .Cells(varRow + 1, varCol)
Cells(7, 2) = .Cells(varRow + 2, varCol)
Cells(8, 2) = .Cells(varRow + 3, varCol)
Cells(9, 2) = .Cells(varRow + 4, varCol)
Cells(10, 2) = .Cells(varRow + 5, varCol)
Cells(11, 2) = .Cells(varRow + 6, varCol)
Cells(12, 2) = .Cells(varRow + 7, varCol)
Cells(13, 2) = .Cells(varRow + 8, varCol)
Cells(5, 4) = .Cells(varRow + 9, varCol)
Cells(6, 4) = .Cells(varRow + 10, varCol)
Cells(7, 4) = .Cells(varRow + 11, varCol)
Cells(8, 4) = .Cells(varRow + 12, varCol)
Cells(9, 3) = .Cells(varRow + 13, varCol)
Bei D zb. sollte es so aussehen
Cells(5, 2) = .Cells(varRow, varCol)
Cells(6, 2) = .Cells(varRow + 1, varCol)
Cells(7, 2) = .Cells(varRow + 2, varCol)
Cells(8, 2) = .Cells(varRow + 3, varCol)
Cells(9, 2) = .Cells(varRow + 4, varCol)
Cells(20, 2) = .Cells(varRow + 5, varCol)
Cells(21, 2) = .Cells(varRow + 6, varCol)
Cells(22, 2) = .Cells(varRow + 7, varCol)
Cells(13, 2) = .Cells(varRow + 8, varCol)
Cells(5, 4) = .Cells(varRow + 9, varCol)
Cells(6, 4) = .Cells(varRow + 10, varCol)
Cells(7, 4) = .Cells(varRow + 11, varCol)
Cells(8, 4) = .Cells(varRow + 12, varCol)
Cells(15, 3) = .Cells(varRow + 13, varCol)
und bei E schauts wieder anderst aus.
Hallo Franz,
ich schreib die Werte in werschiedene Zellen weil mir Tab 1 als Formular herhalten soll und ich darin KEINE Formeln haben möchte und da ich nur ein Formular haben will und nicht für A,B,C eins, für D ein eigenes und für E noch eins. Meine Formeln und Berechnungen sind im Tab2 und das/die Ergebnise kommen dann in andere Zelle.
Tabelle2

	A	B
3		2009
4	RechnungGesamt1	Text 1
5	RechnungGesamt2	Text 2
6	RechnungGesamt3	Text 3
7	RechnungGesamt4	Text 4
8	RechnungGesamt5	Text 5
9	RechnungGesamt6	Text 6
10	RechnungGesamt7	Text 7
11	RechnungGesamt8	Text 8
12	RechnungGesamt9	Text 9
13	RechnungGesamt10	Text 10
14	RechnungGesamt11	Text 11
15	AnteilRech1	Anteil 1
16	AnteilRech2	Anteil 2
17	AnteilRech3	Anteil 3
18	AnteilRech4	Anteil 4
19	AnteilRech5	Anteil 5
20	AnteilRech6	Anteil 6
21	AnteilRech7	Anteil 7
22	AnteilRech8	Anteil 8
23	AnteilRech9	Anteil 9
24	AnteilRech10	Anteil 10
25	AnteilRech11	Anteil 11
26	Name23	nach m³
27	Name24	nach m²
28	Name25	xy
29	Name26	yz
30	Name27	28,25%

definierte Namen
Name	Bezieht sich auf	Tabelle	Z1S1-Formel
Liste1	=Tabelle2!$B$3:$F$3		=Tabelle2!Z3S2:Z3S6

Tabellendarstellung in Foren Version 5.37

Hoffe es hilft Euch weiter. Ich muss den Code erweitern und wohin was eingetragen anpassen können und das kann ich nur mit der ausführlichen schreibweise. Die verschiedenen Bereiche sind auch unterschiedlich lang ausser A-C sind gleich.
Franz Deinen Code versuche ich gleich mal aus.
Gruß Thomas

'Code im Modul der Tabelle1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$3" Or Target.Address = "$C$3" Then Application.EnableEvents = False Range("B5:D17").ClearContents If Range("B3") > 0 And Range("C3") "" Then ReadValues End If Application.EnableEvents = True End If End Sub Sub ReadValues() Dim Jahr As Long, Bereich As String Dim lngRow As Long, lngspalte As Long, pubLngCol As Variant, pubLngRow As Variant On Error Resume Next Application.ScreenUpdating = False Jahr = Range("B3").Value Bereich = Range("C3").Value 'Spalte mit Jahr in Zeile 3 von Blatt "Sheet2" suchen With Sheet2 pubLngCol = Application.WorksheetFunction.Match(Jahr, .Rows(3), 0) 'Zeile unterhalb der Zeile mit dem Bereichsnamen ermitteln pubLngRow = 4 'Zeile für 1. Bereich 'Zeile mit Bereich suchen pubLngRow = Application.WorksheetFunction.Match(Bereich, .Columns(2), 0) + 1 'oder Zeile mit Bereich fest vorgeben Select Case Bereich Case "A": pubLngRow = 4 Case "B": pubLngRow = 32 Case "C": pubLngRow = 52 Case "D": pubLngRow = 72 Case "E": pubLngRow = 90 Case Else MsgBox "Bereich """ & Bereich & """ fehlt als Case" GoTo Beenden End Select Select Case Bereich Case "A", "B", "C" Cells(5, 2) = .Cells(pubLngRow, pubLngCol) Cells(6, 2) = .Cells(pubLngRow + 1, pubLngCol) Cells(7, 2) = .Cells(pubLngRow + 2, pubLngCol) Cells(8, 2) = .Cells(pubLngRow + 3, pubLngCol) Cells(9, 2) = .Cells(pubLngRow + 4, pubLngCol) Cells(10, 2) = .Cells(pubLngRow + 5, pubLngCol) Cells(11, 2) = .Cells(pubLngRow + 6, pubLngCol) Cells(12, 2) = .Cells(pubLngRow + 7, pubLngCol) Cells(13, 2) = .Cells(pubLngRow + 8, pubLngCol) Cells(5, 4) = .Cells(pubLngRow + 9, pubLngCol) Cells(6, 4) = .Cells(pubLngRow + 10, pubLngCol) Cells(7, 4) = .Cells(pubLngRow + 11, pubLngCol) Cells(8, 4) = .Cells(pubLngRow + 12, pubLngCol) Cells(9, 3) = .Cells(pubLngRow + 13, pubLngCol) Case "D" Cells(5, 2) = .Cells(pubLngRow, pubLngCol) Cells(6, 2) = .Cells(pubLngRow + 1, pubLngCol) Cells(7, 2) = .Cells(pubLngRow + 2, pubLngCol) Cells(8, 2) = .Cells(pubLngRow + 3, pubLngCol) Cells(9, 2) = .Cells(pubLngRow + 4, pubLngCol) Cells(20, 2) = .Cells(pubLngRow + 5, pubLngCol) Cells(21, 2) = .Cells(pubLngRow + 6, pubLngCol) Cells(22, 2) = .Cells(pubLngRow + 7, pubLngCol) Cells(13, 2) = .Cells(pubLngRow + 8, pubLngCol) Cells(5, 4) = .Cells(pubLngRow + 9, pubLngCol) Cells(6, 4) = .Cells(pubLngRow + 10, pubLngCol) Cells(7, 4) = .Cells(pubLngRow + 11, pubLngCol) Cells(8, 4) = .Cells(pubLngRow + 12, pubLngCol) Cells(15, 3) = .Cells(pubLngRow + 13, pubLngCol) Case "E" Case Else MsgBox "Bereich """ & Bereich & """ fehlt als Case" GoTo Beenden End Select End With Beenden: Err.Clear Application.ScreenUpdating = True End Sub

'Code im Modul der Tabelle1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$3" Or Target.Address = "$C$3" Then Application.EnableEvents = False If Cells(Rows.Count, 2).End(xlUp).Row >= 5 Then Range(Cells(5, 2), Cells(Rows.Count, 2).End(xlUp).Offset(0, 2)).ClearContents End If If Range("B3") > 0 And Range("C3") "" Then ReadValues End If Application.EnableEvents = True End If End Sub Sub ReadValues() Dim Jahr As Long, Bereich As String Dim lngRow As Long, lngspalte As Long, pubLngCol As Variant, pubLngRow As Variant On Error Resume Next Application.ScreenUpdating = False Jahr = Range("B3").Value Bereich = Range("C3").Value 'Spalte mit Jahr in Zeile 3 von Blatt "Sheet2" suchen pubLngCol = Application.WorksheetFunction.Match(Jahr, Sheet2.Rows(3), 0) 'Zeile unterhalb der Zeile mit dem Bereichsnamen ermitteln pubLngRow = 4 'Zeile für 1. Bereich 'Zeile mit Bereich suchen pubLngRow = Application.WorksheetFunction.Match(Bereich, Sheet2.Columns(2), 0) + 1 'oder Zeile mit Bereich fest vorgeben Select Case Bereich Case "A": pubLngRow = 4 Case "B": pubLngRow = 32 Case "C": pubLngRow = 52 Case "D": pubLngRow = 72 Case "E": pubLngRow = 90 Case Else MsgBox "Bereich """ & Bereich & """ fehlt als Case" GoTo Beenden End Select lngRow = 5: lngspalte = 2 'Daten für alle namen unterdem Bereich auslesen Do Until Sheet2.Cells(pubLngRow, 1) = "" Cells(lngRow, lngspalte) = Sheet2.Cells(pubLngRow, pubLngCol) pubLngRow = pubLngRow + 1 lngRow = lngRow + 1 Loop Beenden: Err.Clear Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread