Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1656to1660
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
Inhaltsverzeichnis

VBA Code erweiter

VBA Code erweiter
09.11.2018 22:44:28
Ray
Hallo die Herren und Damen,
Ich bin der Neue ;)
Ich benötige mal einen Rat.
Ich habe mir eine Formel zurecht gelegt (google) die soweit auch funktioniert.

Private Sub Worksheet_Activate()
Dim strPath As String, strFile As String
strPath = " D:\System\Test "
strFile = "Mappe1.xlsx"
Worksheets(3).Range("D2").Value = GetValue(strPath, strFile, "Tabelle1", "D2")
Worksheets(3).Range("E2").Value = GetValue(strPath, strFile, "Tabelle1", "E2")
Worksheets(3).Range("D3").Value = GetValue(strPath, strFile, "Tabelle1", "D3")
Worksheets(3).Range("E3").Value = GetValue(strPath, strFile, "Tabelle1", "E3")
End Sub

Private Function GetValue(ByVal path As String, ByVal file As String, ByVal sheet As String, _
ByVal ref As String) As String
Dim arg As String
arg = "'" & path & "\[" & file & "]" & sheet & "'!" & Range(ref).Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

Nun ist mir aufgefallen, dass wenn die zu auslesende Zelle Leer ist, Kopiert das Makro eine 0 in die Ziel Zelle. Kann man das irgendwie in der Formel abfangen?
So das die Zelle leer bleibt?
Und eine Frage hätte ich noch.
Ich bräuchte diesen Teil aus den Code mehrfach.
Worksheets(3).Range("D2").Value = GetValue(strPath, strFile, "Tabelle1", "D2")
Immer die Spalte D-E die Zeilen Runter ca. 250 Zeilen.
Ich hatte versucht mir diesen Teil D2... in einer Excel per Zeile runter ziehen auf 250 zu erweitern. Und dann per ="&""&""&"& wieder zusammenzusetzen. Funktioniert ebenfalls gut, nur sobald ich den Zeile dann per copy paste wieder in den Code einfüge und Ausführe, bekomme ich einen "Laufzeitfehler 13" fehler.Wenn ich diesen Teil aber direkt aus dem Code per copy und paste einfüge klappt der Code. Ich hoffe es ist verständlich was ich meine, sonst natürlich gerne fragen.
Wäre schön wenn mir geholfen werden kann.
Schönen Abend noch
Ray

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Code erweiter
10.11.2018 03:19:52
fcs
Hallo Ray,
eine Auswertung von Leerzellen ist hier nicht möglich, da mit dem ExecuteExcel4Macro eine integrierte Excel-Funktion verwendet wird. Falls in der Quelle keine 0-Werte vorkommen, dann kann man die 0-Werte nach der Wertübernahme löschen.
Wenn du Daten aus einem größeren Zellbereich einlesen willst, dann kann man die Zeilen/Spalten in For-Next-Schleifen abarbeiten.
Nachfolgend dein Makro angepasst, aber nicht getestet.
Gruß
Franz
Private Sub Worksheet_Activate()
Dim strPath As String, strFile As String
Dim Zeile As Long, Spalte As Long, StatusCalc As Long
strPath = " D:\System\Test "
strFile = "Mappe1.xlsx"
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
'        .EnableEvents = False 'Falls Worksheet_Change-Ereignismakro verwendet wird.
End With
With Worksheets(3)
For Zeile = 2 To 250 'Zeilennr. anpassen oder dynamisch machen
For Spalte = 4 To 5
.Cells(Zeile, Spalte).Value = GetValue(strPath, strFile, "Tabelle1", _
.Cells(Zeile, Spalte).Address(False, False, xlA1))
'Wenn in Quelle keine 0-Werte aber Leerzellen vorkommen, dann diese so löschen
If .Cells(Zeile, Spalte).Value = 0 Then .Cells(Zeile, Spalte).ClearContents
Next
Next
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = False
.Calculation = StatusCalc
.EnableEvents = True
End With
End Sub

Anzeige
AW: VBA Code erweiter
10.11.2018 19:22:13
Ray
Hallo Franz,
Vielen Dank für deine Mühe.
Sobald ich das Makro getestet habe, melde ich mich.
Danke nochmal
Ray
AW: VBA Code erweiter
11.11.2018 17:53:41
Ray
Hallo Franz hallo Community,
ich konnte nun deinen Code Testen und muss leider feststllen das eine Fehlermelung kommt.
Und zwar wird Private Sub Worksheet_Activate() Gelb gemarkert
und in der Zeile .Cells(Zeile, Spalte).Value = GetValue(strPath, strFile, "Tabelle1", _
wird =GetValue markiert (wie mit Maus)
leider weiß ich nicht wie das behoben werden kann.
Hättest du eine Idee?
LG
Ray
AW: VBA Code erweiter
12.11.2018 04:18:41
fcs
Hallo Ray,
ohne den text der Fehlermeldung kann ich wenig dazu sagen.
Du benötigst natürlich auch weiterhin die Private Function GetValue.
Evtl. hast du die a versehentlich gelöscht.
Gruß
Franz
Anzeige
AW: VBA Code erweiter
12.11.2018 14:30:27
Ray
Hallo Franz,
Also gelöscht habe ich eigentlich nichts.
Die einzigen Punkte die ich angepasst habe waren:
strPath = " D:\System\Verein "
strFile = "Planung.xlsm"
For Zeile = 15 To 150
For Spalte = 1 To 2
und
strFile, "Verein1",
Ich hoffe doch nicht, dass sich so ein fehler eingeschlichen hat.
Die Fehlermeldung ist:
"Fehler beim Kompilieren: Sub oder Function nicht definiert"
Grüße
Ray
AW: VBA Code erweiter
13.11.2018 18:44:44
fcs
Hallo Ray,
ich hab das Makro bezüglich möglicher Fehler verfeinert.
Bei dir hatten sich Leerzeichen in Pfad eingeschlichen.
Gruß
Franz
Private Sub Worksheet_Activate()
Dim strPath As String, strFile As String
Dim Zeile As Long, Spalte As Long, SpaZiel As Long, StatusCalc As Long, varWert
strPath = "D:\System\Verein"
'    strPath = "C:\Users\Public\Documents"
strFile = "Planung.xlsm"
If Dir(strPath & Application.PathSeparator & strFile) = "" Then
MsgBox "Datei" & vbLf & strPath & Application.PathSeparator & strFile & vbLf _
& "existiert nicht!", _
vbOKOnly, "Werte einlesen"
Exit Sub
End If
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
'        .EnableEvents = False 'Falls Worksheet_Change-Ereignismakro verwendet wird.
End With
With Worksheets(3)
For Zeile = 15 To 150 'Zeilennr. anpassen oder dynamisch machen
For Spalte = 1 To 2 'Spalte in Quelldateu
'Zielspalten festlegen
Select Case Spalte
Case 1: SpaZiel = 1
Case 2: SpaZiel = 2
Case Else
SpaZiel = 0
End Select
If SpaZiel > 0 Then
.Cells(Zeile, SpaZiel).Value = GetValue(strPath, strFile, "Verein1", _
.Cells(Zeile, Spalte).Address(False, False, xlA1))
'Wenn in Quelle keine 0-Werte aber Leerzellen vorkommen, dann diese so löschen
varWert = .Cells(Zeile, SpaZiel).Value
If IsError(varWert) Then
ElseIf varWert = 0 Then
.Cells(Zeile, SpaZiel).ClearContents
End If
End If
Next
Next
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = False
.Calculation = StatusCalc
.EnableEvents = True
End With
End Sub
Private Function GetValue(ByVal path As String, ByVal file As String, ByVal sheet As String, _
ByVal ref As String) As Variant 'String
Dim arg As String
arg = "'" & path & "\[" & file & "]" & sheet & "'!" & Range(ref).Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

Anzeige
AW: VBA Code erweiter
13.11.2018 20:07:53
Ray
Hi Franz,
Danke dir, werde ich testen und mich noch mal melden.
Danke
Ray

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige