Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1796to1800
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 - Print, wenn nicht leer

VBA - Print, wenn nicht leer
14.12.2020 17:37:12
excelliebe
Hallo,
ich möchte per VBA-Code eine Ausgabe der Zellinhalte in Spalte B erzeugen, wenn die Zelle in Spalte A der entsprechender Zelle nicht leer ist.
In Spalte A in eine WENN-DANN-Formel hinterlegt - wenn falsch, dann "". Mein VBA-Code erkennt das leider stets als ist nicht leer, da eine Formel in der Zelle hinterlegt ist, auch wenn das Formelergebnis eigentlich "" ist.
Hier mein Tabellenaufbau:

A             B
49 Height#1   12cm
50
51 Width#1    35cm
52
53 Depth#1    32cm
54
55 Weight#1   0,25kg
56
57 Height#2   10cm
58
59 Width#2    93cm
60
61 Depth#2    42cm
62
63 Weight#2   1,20kg
64
65 Height#3   9cm
66
67 Width#3    3cm
68
69 Depth#3   122cm
70
71 Weight#3   0,88kg

Ich möchte jetzt einen Export in den Text-Editor ausgeben. Das funktioniert auch, deshalb habe ich den Code hier auf das wesentlich gekürzt. Und zwar ist meine Schleife falsch. Ich möchte folgende Ausgabe immer für vier Felder, wobei zwischen jedem Feld eine Leerzeile ist.
Folgend mein Versuch:

Sub Export()
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
j = 49
For i = 49 To N
If Cells(i, "A").Value  "" Then
Print #1, "" & Cells(i, 2).Text & ""
Print #1, "" & Cells(i + 4, 2).Text & ""
Print #1, "" & Cells(i + 6, 2).Text & ""
Print #1, "" & Cells(i + 8, 2).Text & ""
j = j + 2
End If
Next i
End Sub
Leider werden die falschen Werte ab der 5. zu übernehmenden Zeile übertragen. Die ersten vier passen.
Kann jemand helfen?
LG

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Print, wenn nicht leer
14.12.2020 17:42:23
excelliebe
Sorry, musste mein Ausgabeformat mit Leerzeichen trennen, wird oben leider nicht richtig _ angezeigt sonst.

Sub Export()
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
j = 49
For i = 49 To N
If Cells(i, "A").Value  "" Then
Print #1, "" & Cells(i, 2).Text & "  "
Print #1, "" & Cells(i + 4, 2).Text & "  "
Print #1, "" & Cells(i + 6, 2).Text & "  "
Print #1, "" & Cells(i + 8, 2).Text & "  "
j = i + 2
End If
Next i
End Sub

AW: VBA - Print, wenn nicht leer
14.12.2020 18:02:13
Nepumuk
Hallo,
ah ja, dann so:
Sub Export()
    
    Dim i As Long
    
    Open "H:\1214\Test.txt" For Output As #1
    
    For i = 49 To Cells(Rows.Count, "A").End(xlUp).Row Step 8
        
        Print #1, "<height>" & Cells(i, 2).Text & "</height>"
        Print #1, "<width>" & Cells(i + 2, 2).Text & "</width>"
        Print #1, "<depth>" & Cells(i + 4, 2).Text & "</depth>"
        Print #1, "<weight>" & Cells(i + 6, 2).Text & "</weight>"
        
    Next i
    
    Close #1
    
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA - Print, wenn nicht leer
14.12.2020 18:14:03
excelliebe
Wow, vielen Dank für die schnelle Antwort! Funktioniert einwandfrei!
Ich glaube durch das .End(xlUp).Row werden auch alle nichtleeren Zellen ausgegeben mit Formelergebnis leer. Ich möchte aber nur die Inhalte ausgeben, wenn in Spalte A der entsprechenden Zeile ein Text (z.B. Höhe, Breite etc.) steht, d.h. das Formelergebnis nicht leer ist.
Würde mich sehr freuen, wenn du hier auch noch helfen könntest :)
AW: VBA - Print, wenn nicht leer
14.12.2020 18:26:19
Nepumuk
Hallo,
so:
Option Explicit

Sub Export()
    
    Dim i As Long, lngLastUsedRow As Long
    
    If GetLastZell(Range(Cells(49, 1), Cells(Rows.Count, 1)), lngLastUsedRow, 0, True, False) Then
        
        Open "H:\1214\Test.txt" For Output As #1
        
        For i = 49 To lngLastUsedRow Step 8
            
            Print #1, "<height>" & Cells(i, 2).Text & "</height>"
            Print #1, "<width>" & Cells(i + 2, 2).Text & "</width>"
            Print #1, "<depth>" & Cells(i + 4, 2).Text & "</depth>"
            Print #1, "<weight>" & Cells(i + 6, 2).Text & "</weight>"
            
        Next i
        
        Close #1
        
    Else
        Call MsgBox("Keine Zellen gefunden.", vbExclamation, "Hinweis")
    End If
End Sub

Public Function GetLastZell( _
        ByRef probjRange As Range, _
        ByRef prlngLastRow As Long, _
        ByRef prlngLastColumn As Long, _
        Optional ByVal povblnReturnLastRow As Boolean = True, _
        Optional ByVal povblnReturnLastColumn As Boolean = True) As Boolean

    
    Dim objCell As Range
    
    If Application.CountBlank(probjRange) <> probjRange.Cells.CountLarge Then
        
        With probjRange
            
            If povblnReturnLastRow Then
                
                Set objCell = .Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
                prlngLastRow = objCell.Row
                
                GetLastZell = True
                
            End If
            
            If povblnReturnLastColumn Then
                
                Set objCell = .Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, _
                    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
                prlngLastColumn = objCell.Column
                
                GetLastZell = True
                
            End If
        End With
        
        Set objCell = Nothing
        
    End If
End Function

Gruß
Nepumuk
Anzeige
AW: VBA - Print, wenn nicht leer
14.12.2020 18:28:06
Nepumuk
Ooooooooooooops,
diese Zeile ist falsch.
 If GetLastZell(Range(Cells(49, 1), Cells(Rows.Count, 1)), lngLastUsedRow, 0, True, False) Then
so ist es richtig:
 If GetLastZell(Range(Cells(49, 2), Cells(Rows.Count, 2)), lngLastUsedRow, 0, True, False) Then
Gruß
Nepumuk
AW: VBA - Print, wenn nicht leer
14.12.2020 17:55:39
Nepumuk
Hallo,
so?
Sub Export()
    
    Dim i As Long
    
    Open "H:\1214\Test.txt" For Output As #1
    
    For i = 49 To Cells(Rows.Count, "A").End(xlUp).Row Step 8
        
        Write #1, Cells(i, 2).Text
        Write #1, Cells(i + 2, 2).Text
        Write #1, Cells(i + 4, 2).Text
        Write #1, Cells(i + 6, 2).Text
        
    Next i
    
    Close #1
    
End Sub

Gruß
Nepumuk
Anzeige

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige