Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
860to864
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
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

860to864: Bitte um Hilfe der VBA-Experten

Bitte um Hilfe der VBA-Experten
12.04.2007 18:40:21
Fritz_W
Hallo Forum,
ich bitte nochmals um die Hilfe der VBA-Experten.
Meine Tabelle "Gesamt" weist die nachfolgende Struktur auf:
Gesamt

 ABCDEFGH
5       3
6Text 1  1   x
7Text 2  1   x
8Text 3  1    
9Text 4  1   x
10Text 5  1    
11Text 6  1   x
12Text 7  1   x
13Text 8  1   x
14Text 9  1   x
15Text 10  1   x
16Text 11  1    
17Text 12  1   x
18Text 13  1   x
19Text 14  1   x
20Text 15  2    
21Text 16  2   x
22Text 17  2   x
23Text 18  2    
24Text 19  2   x
25Text 20  2    
26Text 21  2   x
27Text 22  2    
28Text 23  2   x
29Text 24  2   x
30Text 25  2   x
31Text 26  2   x
32Text 27  2   x
33Text 28  2    
34Text 29  2   x
35Text 30  2   x
36Text 31  3   x
37Text 32  3   x
38Text 33  3   x
39Text 34  3   x
40Text 35  3    
41Text 36  3   x
42Text 37  3    
43Text 38  3   x
44Text 39  3   x
45Text 40  3   x
46Text 41  3   x
47Text 42  3   x
48Text 43  3   x


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Die Tabelle ist bereits aufsteigend nach den Zahlen der Spalte D sortiert. In der Spalte D können Zahlenwerte bis zu 6 vorkommen (jedoch auch weniger). Die Datensätze pro Zahl (Spalte D) kann unterschiedlich sein. Allerdings sind für jede in der Spalte D vorkommende Zahl 11 Datensätze in der Spalte H mit einem "x" versehen. Ich möchte nun die jeweiligen in der Spalte A stehenden jeder Zahl (Spalte D) zugeordneten 11 Textwerte nach folgendem Schema in die Tabelle kopieren, die als Tabellennamen die Zahl in der Zelle H5 der Tabelle Daten trägt (im vorliegenden Fall wäre das die Tabelle "3"):
Die 11 Textwerte (aus Spalte A) mit der Zahl 1 (Spalte D) in den Bereich B5:B15 (in diesem Fall in Tabelle 3)
Die 11 Textwerte (Spalte A) mit der Zahl 2 (Spalte D) in den Bereich J5:J15 (Tabelle 3)
Die 11 Textwerte (Spalte A) mit der Zahl 3 (Spalte D) in den Bereich B20:B30 (Tabelle 3)
Die 11 Textwerte (Spalte A) mit der Zahl 4 (Spalte D) in den Bereich J20:J30 (Tabelle 3)
Die 11 Textwerte (Spalte A) mit der Zahl 5 (Spalte D) in den Bereich B35:B45 (Tabelle 3)
Die 11 Textwerte (Spalte A) mit der Zahl 6 (Spalte D) in den Bereich J35:J45 (Tabelle 3)
Zieltabelle soll jeweils eine Tabelle mit dem Tabellennamen der Zahl in Zelle H5 (Tabelle "Gesamt") sein.
Würde mich über kompetente Hilfe sehr freuen und bedanke mich schon im Voraus für jede Unterstützung.
mfg
Fritz

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe der VBA-Experten
12.04.2007 19:27:48
Erich
Hallo Fritz,
Die Zieltabelle (z. B. "Tabelle 3") sollte schon existieren. Probier mal Option Explicit Sub Uebertrag() Dim zQ As Long, intM As Integer, zZ As Long, sZ As Integer With Sheets("Tabelle " & Cells(5, 8)) For zQ = 6 To Cells(Rows.Count, 1).End(xlUp).Row If intM Cells(zQ, 4) Then intM = Cells(zQ, 4) zZ = 15 * ((Cells(zQ, 4) + 1) \ 2) - 11 sZ = 2 + 8 * ((Cells(zQ, 4) + 1) Mod 2) End If If Cells(zQ, 8) = "x" Then zZ = zZ + 1 .Cells(zZ, sZ) = Cells(zQ, 1) End If Next zQ End With End Sub Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Bitte um Hilfe der VBA-Experten
12.04.2007 20:52:10
Erich
Hi Fritz,
ich hatte (irrtümlich) angenommen, dass die Zieltabelle im Beispiel "Tabelle 3" heißt, nicht "3".
Das Makro ging davon aus, dass "Gesamt" das aktive Blatt ist - nun wird es jedenfalls aktiviert.
Hier die neue Version:

Option Explicit
Sub Uebertrag()
Dim zQ As Long, intM As Integer, zZ As Long, sZ As Integer
Sheets("Gesamt").Select
With Sheets(CStr(Cells(5, 8)))
For zQ = 6 To Cells(Rows.Count, 1).End(xlUp).Row
If intM  Cells(zQ, 4) Then
intM = Cells(zQ, 4)
zZ = 15 * ((Cells(zQ, 4) + 1) \ 2) - 11
sZ = 2 + 8 * ((Cells(zQ, 4) + 1) Mod 2)
End If
If Cells(zQ, 8) = "x" Then
zZ = zZ + 1
.Cells(zZ, sZ) = Cells(zQ, 1)
End If
Next zQ
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Wunderbar!
12.04.2007 21:08:28
Fritz_W
Hallo Erich,
funktioniert tadellos! Ganz großes Kompliment und ein dickes Dankeschön!
Gruß
Fritz
P.S. Habe noch eine kleine Bitte:
Könntest Du dir mal den Code anschauen, den mir Ingo heute morgen in einem anderen Thread geschrieben hat. Der Code macht exakt das, was er eigentlich soll, jedoch dauert das ganze sehr lange
(ca 50 Sek.). Ist das unvermeidlich?
AW: Wunderbar!
13.04.2007 00:16:00
Erich
Hi Fritz,
danke für deine Rückmeldung.
In den anderen Thread hab ich auch was reingeschrieben.
Grüße von Erich aus Kamp-Lintfort
@ Erich G.
13.04.2007 08:52:13
Fritz_W
Hallo Erich,
ich bin erstaunt über die Wirkung, die deine Änderungen auf die Laufzeit des Makros hatte (siehe meinen letzten Beitrag im anderen Thread). Dein obiges Makro läuft zwar keine 50 Sekunden, aber immerhin ca. 18 Sekunden. Meine Frage deshalb: Könnte man diese Laufzeit evtl. auch verkürzen?
Viele Grüße und nochmaligen Dank!
Fritz
Anzeige
AW: mit Beschleuniger
13.04.2007 13:02:11
Erich
Hallo Fritz,
dazu braucht man nur die drei Zeilen mit "...Calc..." zu ergänzen.
Die Prozedur "Beschleuniger" stelle ich hier noch mal mit rein,
du brauchst sie nur einmal in einem Modul.

Option Explicit
Sub Uebertrag()
Dim zQ As Long, intM As Integer, zZ As Long, sZ As Integer
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Sheets("Gesamt").Select
With Sheets(CStr(Cells(5, 8)))
For zQ = 6 To Cells(Rows.Count, 1).End(xlUp).Row
If intM  Cells(zQ, 4) Then
intM = Cells(zQ, 4)
zZ = 15 * ((Cells(zQ, 4) + 1) \ 2) - 11
sZ = 2 + 8 * ((Cells(zQ, 4) + 1) Mod 2)
End If
If Cells(zQ, 8) = "x" Then
zZ = zZ + 1
.Cells(zZ, sZ) = Cells(zQ, 1)
End If
Next zQ
End With
Beschleuniger Calc
End Sub
' --------------- ab hier wahrscheinlich schon vorhanden: ---------------
'   Beschleuniger _______ Parameter: Calc-Status ______ gi/12.03.2006
'Aufruf:
'   Dim Calc As XlCalculation
'   Calc = Application.Calculation: Beschleuniger xlCalculationManual
'   ....Code....
'   Beschleuniger Calc
Sub Beschleuniger(StatCal As XlCalculation)
Application.Calculation = StatCal
Application.EnableEvents = (StatCal  xlCalculationManual)
Application.ScreenUpdating = (StatCal  xlCalculationManual)
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: mit Beschleuniger
13.04.2007 13:34:00
Fritz_W
Hallo Erich,
das ist ja phantastisch, läuft nun wie der Blitz! Danke!!
Bis (in meinem Sinne) demnächst
Gruß und ein schönes WE
Fritz
Danke für Rückmeldung - Auch schönes WoEnde (oT)
13.04.2007 13:37:00
Erich

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige