Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1504to1508
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
1504to1508
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife für vba mit jeweilskleinen änderungen

Schleife für vba mit jeweilskleinen änderungen
26.07.2016 12:46:40
Chrostiffer
Hallo Zusammen,
ich bin seit einiger Zeit dabei, Makros für die Arbeit anzufertigen, damit wiederholende Sachen leichter & schneller gehen. Meine Kenntnisse sind alle selber beigebracht, teils durch Foren wie hier oder aber auch den Recorder. Beim Recorder nutze ich dann aber nur die Funktionen, select & Co. nutze ich nicht.
Nun zum Problem:
Ich habe unten stehenden Excel vba geschrieben. Dieser steht für eine Basisliste, aus der ich nach Ländern filtere. Davon nehme ich dann teile der Daten raus, um sie in einem neuem Tabellenblatt (mit vorgefertigter Maske) grafisch bzw. tabellarisch darzustellen.
Wie kann ich diesen Teilcode, der sich für jedes Land (weltweit) wiederholt, als Schleife darzustellen, sodass ich kein elend langen Code mit wiederholungen habe?
"i = " würde ich am besten Über die Tabelle, Spalte 16 machen - dort wird der Landescode (DE,DK, etc..) angezeigt.
Im Vorfeld formatiere ich eine Rohdatentabelle als Export Tabelle (Strg + T).
Sheet Sales_customer_ranking ist mein "aufgehübschtes" Übersichtsblatt, bei dem die Top 30 Kunden des jeweiligen Landes sind.
Sheets "NeuesBlatt" war für mich die einzige Lösung, aus der gefilterten Tabelle die sichtbaren Daten zusammen in die neue Tabelle zu importieren.

VIELEN DANK IM VORAUS für Ideen und Verbesserungsvorschläge

Exemplarischer Teilcode für ein Land - Beispiel DE (Deutschland)
In fett dargestellt sind die Punkte, die sich bei jedem Land unterscheiden. Alles andere bleibt im Prinzip gleich.
++++++++++++++++++++++++++++
Sheets("Sales_Customer_Ranking").Copy After:=Sheets(1)
Sheets("Sales_Customer_Ranking (2)").name = "DE"
ActiveWorkbook.Worksheets("Export").ListObjects("Tabelle5").Sort.SortFields. _
Clear
Worksheets("Export").ListObjects("Tabelle5").Range.AutoFilter Field:=16, Criteria1:= _
"DE"
ActiveWorkbook.Worksheets("Export").ListObjects("Tabelle5").Sort.SortFields. _
Add Key:=Range("Tabelle5[[#All],[MBUDGET_LC]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Export").ListObjects("Tabelle5").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.name = "NeuesBlatt"
ActiveWorkbook.Sheets("Export").Range("C2:E1700").SpecialCells(xlCellTypeVisible).Copy Worksheets("NeuesBlatt").Range("A1")
ActiveWorkbook.Sheets("Export").Range("K2:O1700").SpecialCells(xlCellTypeVisible).Copy Worksheets("NeuesBlatt").Range("D1")
Sheets("NeuesBlatt").Range("A1:H30").Copy
Sheets("DE").Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NeuesBlatt").Delete
Sheets("DE").Select
Sheets("DE").Range("I1").FormulaR1C1 = "=TODAY()"
Sheets("DE").Range("C3") = Sheets("Rohdaten").Range("I2")
Sheets("DE").Range("C4") = "GERMANY"

Worksheets("DE").Range("H6").Value = Worksheets("EXPORT").Range("U1").Value
Range("H6:H7").Merge
With Range("H6:H7")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Worksheets("DE").Range("H10:H39").ClearContents
Worksheets("DE").Range("H10:H39").FormulaR1C1 = "=IFERROR((RC[-2]-RC[-1])/ABS(RC[-1]),"" "")"
Worksheets("DE").Range("H10:H39").Style = "Percent"

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife für vba mit jeweilskleinen änderungen
27.07.2016 03:57:47
fcs
Hallo Christoffer,
im Prinzip kann man es wie folgt lösen.
Die allgemeine Subroutine kannst du dann in einer Schleife aufrufen, wenn du eine tabelle mit den Länderdaten hast oder indem du für jedes Land eine Zeile anlegst, die die Sub-Routine aufruft.
Ohne die gefilterten Daten in ein neues Blatt zu kopieren könnten die Anweisungen wie folgt aussehen. 
    wksExport.Range("C2:E1700").SpecialCells(xlCellTypeVisible).Copy wksLand.Range("B10")
wksExport.Range("K2:O1700").SpecialCells(xlCellTypeVisible).Copy wksLand.Range("E10")

Ich weiss aber nicht, ob dann evtl. unerwünschte Formatierungen/Daten/Formeln mit in das Blatt für die Länder kopiert werden.
Gruß
Franz 

Sub prcTest_Schleife()
'Variante mit Schleife über Länder-Liste
Dim wksLaender As Worksheet
Dim Zeile As Long
Dim x As Long
x = 42
Set wksLaender = Worksheets("TabelleYXZ") 'Tabellenblatt mit Länder-Liste
Application.ScreenUpdating = False
For Zeile = 2 To x
Call prcCopyDatenLand(strLand:=wksLaender.Cells(Zeile, 16).Text, _
strLandName:=wksLaender.Cells(Zeile, 17).Text)
Next
Application.ScreenUpdating = True
End Sub
Sub prcTest2()
'Variante für jedes Land wird Sub-Routine aufgerufen
Application.ScreenUpdating = False
Call prcCopyDatenLand(strLand:="DE", strLandName:="GERMANY")
Call prcCopyDatenLand(strLand:="DK", strLandName:="DENMARK")
Application.ScreenUpdating = True
End Sub
Sub prcCopyDatenLand(strLand As String, strLandName As String)
Dim wksExport As Worksheet
Dim wksLand As Worksheet
Dim wksNeu As Worksheet
Set wksExport = ActiveWorkbook.Worksheets("Export")
Sheets("Sales_Customer_Ranking").Copy After:=Sheets(1)
Set wksLand = Sheets("Sales_Customer_Ranking (2)") 'oder = Sheets(2)
wksLand.Name = strLand
wksExport.ListObjects("Tabelle5").Sort.SortFields.Clear
Worksheets("Export").ListObjects("Tabelle5").Range.AutoFilter Field:=16, _
Criteria1:=strLand
wksExport.Activate
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Add Key:=Range("Tabelle5[[#All],[MBUDGET_LC]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With wksExport.ListObjects("Tabelle5").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set wksNeu = Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
wksNeu.Name = "NeuesBlatt"
wksExport.Range("C2:E1700").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("A1")
wksExport.Range("K2:O1700").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("D1")
wksNeu.Range("A1:H30").Copy
wksLand.Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
wksNeu.Delete
Application.DisplayAlerts = True
With wksLand
.Select
.Range("I1").FormulaR1C1 = "=TODAY()"  'oder = Date
.Range("C3") = Sheets("Rohdaten").Range("I2")
.Range("C4") = strLandName
.Range("H6").Value = wksExport.Range("U1").Value
.Range("H6:H7").Merge
With .Range("H6:H7")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.Range("H10:H39").ClearContents
.Range("H10:H39").FormulaR1C1 = "=IFERROR((RC[-2]-RC[-1])/ABS(RC[-1]),"" "")"
.Range("H10:H39").Style = "Percent"
End With
End Sub

Anzeige
AW: Schleife für vba
01.08.2016 10:42:42
Chrostiffer
Hallo Franz,
vielen Dank für deine ausführliche Hilfe. Die Schleife ist so einfach aber doch genial.
Ich lerne jedes mal dazu.
Kannst du mir bei 3 Sachen dennoch helfen?
1. Nicht bei jeder Abfrage hat jedes Land immer Umsätze zu verzeichnen. Dies bedeutet, dass in der Sortierung 
Worksheets("Export").ListObjects("Tabelle5").Range.AutoFilter Field:=16, Criteria1:= _
"BEISPIEL"
keine Auswahl getroffen werden kann und der Code bei
 wksExport.Range("C2:E1700").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("A1")
wksExport.Range("K2:O1700").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("D1")
ein Fehler anzeigt (Tabelle hat keine Zeilen zu kopieren).
Gibt es die Möglichkeit einen Error zu vermeiden und das Land entsprechend auszulassen sofern es in der Tabellenauswahl nicht vorhanden ist?
2. Ich möchte das ganze unter bestimmten Namen (generiert aus der Excel) speichern. Bisher habe ich es so:
Dim dialog As Object
Dim Pfad As String
Dim datei As String
Dim segment As String
Dim month As String
Dim name As String
ChDrive "C:"
ChDir "C:\Users\pfad\"
Pfad = "C:\Users\Pfad\"
datei = Format(Sheets("DE").Range("I1"), "yyyy-mm-dd")
name = Sheets("DE").Range("B1")
segment = Sheets("DE").Range("C3")
month = Sheets("DE").Range("I5")
ActiveWorkbook.SaveAs Filename:=Pfad & segment & "_" & month & "_" & name & "_" & "ALL_" &  _
datei, FileFormat:= _
xlOpenXMLWorkbook
Gibt es die Möglichkeit, den Pfad je nach User indivduell auf z.B. "Standard speicherort" einzustellen und die Dialogbox zu öffnen? leider hatte beim dialogbox öffnen bisher einen Fehler wegen Formatierung von .xls auf .xlsx bekommen, deshalb das direkt speichern.
3. Das Makro soll intern an andere Kollegen weitergegeben werden. Würde das Makro dann unter der "personal.xlsb" speichern lassen.
Dafür müsste das Makro jedoch im Vorfeld den Speicherort der Basis.xls Datei (Template, Länderliste etc.) abfragen. bisher öffne ich das Workbook direkt mit Pfad.
Gibt es die Möglichkeit eine Abfrage zu starten wo sich die Basis.xls befindet und ggf. diese Abfrage für spätere Anwendungen zu speichern im Makro? Also das dieser Speicherort hinterlegt wird und am anfang abgefragt wird. Falls vorhanden nicht mehr abfragen.
Du hast mir auf jeden Fall sehr geholfen! Vielen Dank im Vorfeld für deine weiteren Mühen.
beste Grüße
Chrostiffer
Anzeige
AW: Schleife für vba
01.08.2016 21:55:19
fcs
Hallo Chrostiffer,
zu 1. und 2. hab ich dir die Makros angepasst
https://www.herber.de/bbs/user/107358.txt
zu 3.:
du kannst die Makros in der Basis-Datei speichern.
Wenn die Basisdatei am Ende als XLM-Datei ohne Makros gespeichert wird, dann ist die Datei ja wieder Makrofrei.
Information nachträglich in ein Makro einbauen erfordert, dass der Makro-Schutz vom Anwender entsprechend angepasst wurd und der Zugriff auf Makros erlaubt wird.
Gruß
Franz
AW: Schleife für vba
02.08.2016 15:09:52
Chrostiffer
Hallo Franz,
du warst mir eine große Hilfe. Ich habe deinen Code fast komplett übernommen und in meinen übrigen Code integriert. Es klappt alles super.
Ein paar Sachen habe ich noch geändert (z.B. beim Speichern eine Dialogbox).
Punkt 3 habe ich deine Idee aufgenommen. Über ein neues Tabellenblatt in Basis.xls mit einem Button eine neues Makro ausgelöst. Dort habe ich eine weitere Sub zur Prüfung ob die SALES_PER_CUSTOMER geöffnet ist geschrieben: Ja = call deinen Code; nein = MsbBox mit Anweisung wie eine solche xls aus dem System generiert werden kann.
Funktioniert auch auf anderen Rechnern mit anderen Usern.
Also glücklich gerade! :)
Vielen Dank nochmal!
Grüße
Chrostiffer.
Anzeige

305 Forumthreads zu ähnlichen Themen

If...Then... bei verschiedenen Bedingungen?
Vic

Hallo zusammen
Ich habe folgendes Problem und weiss nicht, wie ich das über mein Marko gelöst bekomme:
In der Spalte "H" habe ich diverse Werte (zwischen 0 und X) und in der Spalte "K" ebenfalls. Nun möchte ich, dass es in der Spalte "L" eine "0" ausgibt, wenn "H" den Wert Null hat und...
13.08.2008 15:00:00
Thread-ID: 1001553
5 Beiträge
Anzeige
Dateiformat nicht erkennabar (VBA)
Richard

hallo
hab da ein vba-skript, das beim unteren der beiden Zeilen eine Fehlermeldung bringt:
CreateObject("Scripting.FileSystemObject").CopyFile "C:\Program Files\" & Dateiname_neu, "C:\Program Files\Kopie.txt", True
Workbooks.OpenText FileName:="C:\Program Files\Kopie.txt" _
02.10.2008 19:52:02
Thread-ID: 1013959
2 Beiträge
Mit VBA ein anderes Makro ändern
Markus

Hallo zusammen,
besteht die Möglichkeit, dass man mittels Makros ein anderes Makro bzw. den Code für Worksheet_Activate ändern kann?
Problem 1
Sub Worksheet_Activate() 'ScrollArea = "C3: Bf32" ScrollArea = "" End Sub
Es soll danach wie folgt aussehen (Änderung in Zeile 1 und...
12.10.2008 14:24:49
Thread-ID: 1015855
7 Beiträge
Anzeige
Command Button schützen vor VBA
Hüseyin

Hallo zusammen,
habe eine kurze Frage und hoffe ihr könnt mir weiterhelfen,
ich habe ein Exceldokument mit Commandbuttons drin. Wenn ich allerdings über VBA eine "Sortierung" oder "Komprimierung" über das Tabellenblatt laufen lasse, werden meine Buttons kleiner bzw. sehen gequetscht aus...
28.10.2008 11:21:33
Thread-ID: 1019856
3 Beiträge
Umwandeln in Zahlen mit VBA
Bernhard

Hallo liebe Excel-Experten,
heute brauche ich Eure Hilfe für folgendes Problem: Ich importiere Daten aus einer anderen Anwendung nach Excel und ich bekomme die Zahlen als Text formartiert. Die Zahlen sehen z.B. wie folgt aus: 4.75m, was als Zahl 4750000 entspricht. Ist es mit einem VBA-Code...
25.11.2008 13:46:12
Thread-ID: 1027705
4 Beiträge
Zugriff auf andere Programm/Daten in/exportieren
abu

Hallo Zusammen,
ich wuerde gerne wissen ob Excel in der Lage ist aus einem anderen Programm (Prologs) Daten zu exportiern und darzustellen und umgekehrt. Desweiteren wuerde ich gerne eine Routine in Excel programmieren (besser versuchen hinzubekommen) welche ueber den InternetExplorer auf e...
09.12.2008 10:50:51
Thread-ID: 1031278
11 Beiträge
VBA Script in andere Tabellen
Jörg

Hallo,
mich würde mal interessieren, ob es möglich ist, das Script einer Tabelle öffentlich für andere Tabellen zu machen. Derzeit ist es so, wenn ich das Makro in anderen Tabellen anwende, öffnet sich erst die Tabelle in der das Makro drin steht. Kann man das umgehen?
Für Eure Hilfe vi...
14.01.2009 11:42:23
Thread-ID: 1039546
16 Beiträge
if then interiorcolor
serge

Hallo Leute
ich möchte dass wenn die angeklicke Zelle Rot ist mein Makro ablauft (es können verschiedene Zellen sein.
Ich habe es mit:
Private Sub Worksheet_selectionChange(ByVal Target As Range) If Target.Interior.ColorIndex = 3 Then "mein makro" End If End Sub
unter anderem...
21.01.2009 22:45:00
Thread-ID: 1042391
15 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
4
2
1
6
7
2
3
10
15
14
6
4
4
1
3
4
2
7
1
11
2
3
1
8
1