Office: erbitte Kontrolle und Verbesserung meines Bastelcodes

Darthmike · 29. November 2020

Servus zusammen,

ich habe folgenden Code zusammen gebastelt aus schon vorhandenen Codes und würde nun gerne diesen optimiert haben.

Dieser Code ist funktional, aber ich habe bedenken, das dies so auch richtig ist und dieser Code wesentlich verkürzt werden kann und 3 Punkte würde ich auch gerne optimieren:

Punkt 1:
Wird nicht Spalte C markiert vorm ausführen des Makros kommt richtigerweise die MsgBox mit dem Hinweis "Die Auswahl muss über die Spalte C erfolgen".
Quittiere ich diese mit OK - läuft das Makro aber weiter durch (jedoch nur teilweise). Richtig wäre das der Ablauf komplett gestoppt wird und nichts weiter läuft.
Was habe ich hier falsch gemacht, und wie könnte es richtig sein.

Punkt 2:
Ich kopiere ja aus einer Tabelle Daten in eine andere Tabelle. Hier werden jedoch die Zellen mit der Formatierung rüberkopiert.
Wie kann ich das ändern, so das er mir die Werte ohne Formatierung kopiert und einfügt.

Punkt 3:
Wie kann man den Code optimal verkürzen bzw. was würdet ihr anders machen als erfahrene Nutzer?

Hier der Code mit dem ich das Makro anstoße (ist ein eigenes Modul):
Code:

Option Explicit
Sub Ordneranlage_steuerung()
Call schnell_ordneranlage_1
Call CreatePaths
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier der 2. Code (ebenfalls ein eigenes Modul):
Code:

Sub schnell_ordneranlage_1()
' Version V3 Testen lernen Testen
Dim r1 As Long, r2 As Long ' Zeilen# markierter Bereich
Dim c1 As Long, c2 As Long ' Spaltengrenzen des zu markierenden Bereichs
Dim d1 As Long, d2 As Long ' Spaltengrenzen des zu markierenden Bereichs Nr2

Dim z As Long ' erste freie Zeile Ziel-Tabelle
Dim wsE As Worksheet ' Ziel-Tabelle
Dim rng As Range ' zu kopierender Bereich
Dim c3 As Long, c4 As Long ' Spaltengrenzen des zu markierenden Bereichs

' löschen
Tabelle4.Range("I10:I209").ClearContents
Tabelle4.Range("L10:Q209").ClearContents

' check Bereichs-Auswahl
' Die Auswahl erfolgt über die Markierung der Zelle in Spalte C
With Selection
r1 = .Row ' erste Zeile und
r2 = r1 + .Rows.Count - 1 ' letzte Zeile des zu kopierenden Beeichs
If .Column Range("C1").Column Then ' ausgewählte Spalte ist nicht die Spalte C
MsgBox "Die Auswahl muss über die Spalte C erfolgen !", vbExclamation
Exit Sub
End If
End With

' definiere den zu kopierenden Bereich
With ActiveSheet
c1 = 7 ' Spalte G = Start-Spalte des zu kopierenden Bereichs
c2 = .Range("G1").Column ' Spalte G = Ende-Spalte des zu kopierenden Bereichs
Set rng = .Range(.Cells(r1, c1), .Cells(r2, c2))

' Kopieren Auswahl
Set wsE = Worksheets("Eingabe")
z = wsE.Cells(Rows.Count, "S").End(xlUp).Row + 1 ' erste freie Zeile in Ziel-Tabelle
rng.Copy wsE.Range("I" & z)
With wsE
.Range(.Cells(z, c1), .Cells(z + r2 - r1, c2)).Rows.EntireRow.AutoFit
'definiere den zu kopierenden Bereich 2
With ActiveSheet
c1 = 1 ' Spalte G = Start-Spalte des zu kopierenden Bereichs
c2 = .Range("F1").Column ' Spalte G = Ende-Spalte des zu kopierenden Bereichs
Set rng = .Range(.Cells(r1, c1), .Cells(r2, c2))

' Kopieren Auswahl
Set wsE = Worksheets("Eingabe")
z = wsE.Cells(Rows.Count, "S").End(xlUp).Row + 1 ' erste freie Zeile in Ziel-Tabelle
rng.Copy wsE.Range("L" & z)
With wsE
.Range(.Cells(z, c1), .Cells(z + r2 - r1, c2)).Rows.EntireRow.AutoFit
End With
End With

Sheets("Eingabe").Activate

With Range("L10:L209,M10:M209,N10:N209,O10:O209,P10:P209,Q10:Q209")

.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
End With

Sheets("Aktiv IRT02").Activate
End Sub

Public Sub CreatePaths()
Dim wks As Worksheet
Dim i As Long
Dim lngRowsCount As Long
Dim lngResult As Long

Dim strFullPath As String
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier der 3. Code (kein eigenes Modul sondern im Tbl hinterlegt)
Code:

Public Sub CreatePaths()
Dim wks As Worksheet
Dim i As Long
Dim lngRowsCount As Long
Dim lngResult As Long

Dim strFullPath As String

Const cSHEET_CODENAME = "Tabelle8"
Const cCOL = 7: Const cROW = 4

Set wks = SheetFromCodeName(cSHEET_CODENAME, ThisWorkbook)

lngRowsCount = wks.Cells(wks.Rows.Count, cCOL).End(xlUp).Row

For i = cROW To lngRowsCount
strFullPath = wks.Cells(i, cCOL)

If CreateDirectory(strFullPath) Then
If MsgBox("Ordner wurden erstellt") Then
Exit For
End If
End If
Next
End Sub

' This function gets the worksheet object from the Code Name
' excel-vba-worksheet/#Using_the_code_name_of_a_Worksheet
Public Function SheetFromCodeName(Name As String, bk As Workbook) As Worksheet
Dim sh As Worksheet

For Each sh In bk.Worksheets
If sh.CodeName = Name Then
Set SheetFromCodeName = sh
Exit For
End If
Next sh
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und hier der 4. Code (wieder in einem eigenen Modul)
Code:

' Modul: modSHCreateDirectory
' *****************************************************************************
'
Option Explicit

Public Const MOD_NAME As String = "modSHCreateDirectory"

' Error constants for SHCreateDirectoryEx
Public Const ERROR_BAD_PATHNAME = 161&
Public Const ERROR_FILENAME_EXCED_RANGE = 206&
Public Const ERROR_PATH_NOT_FOUND = 3&
Public Const ERROR_FILE_EXISTS = 80&
Public Const ERROR_ALREADY_EXISTS = 183&
Public Const ERROR_CANCELLED = 1223&
Public Const ERROR_SUCCESS = 0&

#If VBA7 Then
Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" _
Alias "SHCreateDirectoryExW" ( _
ByVal hwnd As LongPtr, _
ByVal pszPath As LongPtr, _
ByVal psa As LongPtr _
) As Long
#Else
Private Declare Function SHCreateDirectoryEx Lib "shell32" _
Alias "SHCreateDirectoryExW" ( _
ByVal hwnd As Long, _
ByVal pszPath As Long, _
ByVal psa As Long _
) As Long
#End If

Public Function CreateDirectory(ByVal FullPath As String) As Long
CreateDirectory = SHCreateDirectoryEx(0&, StrPtr(FullPath), 0&)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich hoffe es melden sich viele Erfahrene und wichtig wäre mir auch eine Erklärung, was ich (noch als unwissender) Falsch bzw. anders machen müsste.
Ich lerne daraus.
Da ich derzeit Kurzarbeitsbedingt etwas mehr Zeit habe, vertiefe ich mich ein wenig in das Ganze. Naja ich bastel halt rum in der Hoffnung immer mehr zu verstehen;-)

Vielen herzlichen Dank für Eure Verbesserungsvorschläge und eure Erfahrungen.

Liebe Grüße
Miche

Wer nicht probiert, lernt nix dazu...

:)

knobbi38 · 1. Dezember 2020

Hallo Miche,

kleine Anmerkung vorab:

ich habe folgenden Code zusammen gebastelt aus schon vorhandenen Codes
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ich nehme mal an, daß du dir den Code eher zusammengesucht hast, als das du ihn selber erstellt hast, sonst hättest du sicherlich eine einheitlichere und durchgängige Namenskonvention verwendet. Wenn du schon Code kopierst, solltest du zumindest die Quellen angeben, das würde ermöglichen, sich die Anmerkungen im Original anschauen zu können und gebietet die Fairness gegeben über denjenigen, welche den ursprünglich Code erstellt haben. Auch wäre es interessant für andere Mitleser, die eventuell den Code auch übernehmen möchten, ggf. sogar im Original.

zu 3):
Was möchtest du daran optimieren? Eine Fehlerbereinigung wäre vielleicht interessanter.
Code:

If CreateDirectory(strFullPath) Then
If MsgBox("Ordner wurden erstellt") Then
Exit For
End If
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Auswertung des Rückgabewertes der beiden Funktionen von CreateDirectory() und MsgBox() ist so nicht richtig, denn sie liefern keinen Boolean-Wert zurück und führen desjalb nicht zum gewünschten Resultat. Hier solltest du dir die möglichen Funktions-Rückgabewerte nochmal ansehen und entsprechend reagieren und wieso soll die Schleife abgebrochen werden, wenn der erste Ordner erstellt worden ist?

Gruß Ulrich

Darthmike · 1. Dezember 2020

Hallo und danke das du dich meiner annimmst.

Deine Annahme ist richtig. Das habe ich auch oben geschrieben. Schon vorhandene Codes von denen ich die Quellen nicht alle weiß und zusammengebastelt und selbst entsprechend abgeändert.
Werde das für die Zukunft besser machen.
Und ja es geht mir um Fehlerbehebung, Bzw Verbesserung.
Im Grunde funktioniert das Makro ja. Die Ordner werden ja erstellt.
Jedoch würde ich gerne wissen wie das ganze kürzen bzw. besser machen kann.
Ich versuche immer aus bestehenden Codes etwas neues zu kreieren und hoffe dabei immer mehr zu lernen.

Zu der Schleife.:
Ich möchte das Makro nur abbrechen wenn zum starten nicht die Spalte C aktiviert ist.

Viele Grüße

knobbi38 · 2. Dezember 2020

Hallo Miche,

ich meinte eigentlich die Schleife in CreatePaths(). Wie gesagt, da mußt du die Auswertung der Rückgabewerte ändern.

Was dein Check für die Spalte C betrifft, wird dabei ja nur schnell_ordneranlage_1() abgebrochen und die aufrufende Prozedur macht mit CreatePaths() weiter.

Schau dir auch nochmal die Ausführungspostion des Checks innerhalb von schnell_ordneranlage_1() an: erst etwas löschen und dann den Check durchführen?

Insgesamt muß du dir nochmal den Programmablauf zu Gemüte führen und eventuell überarbeiten. Auch die Auswertung von Rückgabewerte von Funktionen, wie z.B. Msgbox, wäre angebracht.

Gruß Ulrich

Darthmike · 2. Dezember 2020

Wie wäre dein Lösungsansatz?

Leider ist mein wissen hierzu sehr begrenzt.
Ich hab da Stunden schon verbracht um es irgendwie funktional zu bekommen.
Leider weiß ich es nicht besser...

Viele Grüße

knobbi38 · 2. Dezember 2020

Hallo Miche,

ein Forum ist denkbar schlecht dafür geeignet, Grundlagenwissen zu vermitteln. Hier würde ich dann doch auf entsprechende Fachbücher zurückgreifen, zum einen welche, die sich mit der Programmierung als solches befassen, z.B. strukturelle Ablaufpläne usw., und zum anderen welche, die sich dann mit Excel und VBA gezielt auseinandersetzen.

Als Nachschlagwerk für die einzelnen VBA Anweisungen und Funktionen sowie dem Objektmodell von Excel kann dann die Hilfe oder die Onlinehilfe dienen:
https://docs.microsoft.com/de-de/off.../api/overview/

Was den Programmablaufplan betrifft, würde ich als ersten Ansatz den Check für die selektierte Spalte als selbständige Funktion mit einem boolean Rückgabewert herausziehen und die eigentlichen Aktionen in einen IF - Zweig packen: (air code)
Code:

Sub Ordneranlage_steuerung()
If IsActiveColumn(3) Then ' entspricht: If IsActiveColumn(3) = True Then
Call schnell_ordneranlage_1
Call CreatePaths
End If
End Sub

Private Function IsActiveColumn(byval Column as Long) as Boolean
...
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit If ... Then ... Else ... End If wird der Programmablauf strukturiert und ein Codeblock nur in Abhängigkeit von einer Bedingung ausgeführt. Ich sagte ja schon, daß du die Rückgabewerte auswerten solltest.

Wenn es dir hilft, kannst du im VBA Code Breakpoints setzten und dann im Einzelschrittmodus deinen Programmablauf mal durchgehen.

Gruß Ulrich

Darthmike · 15. Dezember 2020

Ganz vielen Dank für deine Antwort

Office: erbitte Kontrolle und Verbesserung meines Bastelcodes

erbitte Kontrolle und Verbesserung meines Bastelcodes

erbitte Kontrolle und Verbesserung meines Bastelcodes

erbitte Kontrolle und Verbesserung meines Bastelcodes

erbitte Kontrolle und Verbesserung meines Bastelcodes - Similar Threads - erbitte Kontrolle Verbesserung

Pivot Tabelle

Erbitte komplizierte Formel Wenn,dann oder wenn dies, dann

Verückte Kontroll & Optionsfelder

VBA speichern als PDF mit kontrolle der Namensgebung

Kontrolle, dass ein Wert nicht über/-unterschritten wird

Kontroll Funktion

Kontrolle der Gästebucheinträge