Thema Datum  Von Nutzer Rating
Antwort
Rot Problem mit Excel Makro um leere Zellen zu löschen
 29.08.2014 08:51:31 Manuel
NotSolved

Ansicht des Beitrags:
Von:
Manuel		 Datum:
29.08.2014 08:51:31		 Views:
1828		 Rating:
     
Antwort:
  Ja
Thema:
Problem mit Excel Makro um leere Zellen zu löschen

Guten Tag,

ich habe ein kleines Problem mit einem Makro. Zur Erklärung: Ich habe ein Word Formular erstellt das ein Modul enthält welches die in das Word Formular eingetragenen Daten in eine Excel Tabelle überträgt. Das ganze funktioniert auch wunderbar. Nun habe ich aber vor, das ganze etwas zu erweitern. Ein Kunde der mit diesen erstellten Excel Tabellen arbeiten bzw. ein Makro anwenden muß welches diese Daten wiederum ausliest und benötigte Ersatzteile auflistet, bemängelt das die erstellte Excel Tabelle usedRange Einträge erstellt die nicht vorhanden sein dürften. Normalerweise würde das vom Kunden ausgeführte Makro die zu bestellenden Ersatzteile mit einer leere Zeile Abstand, unter den aufgelisteten Daten eintragen. Allerdings passiert dies erst in Zeile 502. Das bedeutet das mein Makro aus irgend einem Grund 501 usedRange Einträge erstellt in denen aber nichts drin steht. Wenn ich mir mein Makro anschaue sehe ich nicht warum dies der Fall sein sollte.

Nun versuche ich dieses Problem damit zu lösen das mein Makro nachdem es die Daten aus dem Formular in die Tabelle übertragen hat und bevor diese Tabelle gespeichert und wieder geschlossen wird, alle leeren Zellen löschen soll. Allerdings löscht dieser Code dann auch leere Zellen die erwünscht sind und genau das versuche ich zu vermeiden, weis jedoch nicht genau wie ich das am besten anstelle.

Ich poste einmal das komplette Makro, damit man das mal genauer in Augenschein nehmen kann. Bitte nicht über die sehr lineare Programmierweise wundern, ich bin kein VBA Experte und versuch mir das ganze so einfach wie möglich zu machen.

Hier ist der Code zum auslesen und übertragen des Inhalts des Word Formulars an die Excel Tabelle:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Sub DataTransfer()
   Dim xlApp As Object
   Dim xlWBook As Object
   Dim fld As FormField
   Dim nRow As Long
   Dim nCol As Integer
   Dim ws As Object
   Dim ldfNr As Integer
   Dim rng As Range
   Const xlUp = -4162
    
    Application.ScreenUpdating = False
     
    Set xlApp = CreateObject("excel.Application")
    Set xlWBook = xlApp.Workbooks.Open(ThisDocument.Path & "\artexGeräteliste.xlsm")
    xlWBook.Application.Visible = True
    xlWBook.Application.Sheets("Geräteübersicht").Select
    Set ws = xlWBook.Sheets("Geräteübersicht")
    nRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row + 1
    ldfNr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
     
    If ldfNr = 0 Then
    ws.Cells(ldfNr + 1, 1) = 1
    Else
    ws.Cells(ldfNr + 1, 1) = ldfNr - 2
    End If
     
     
    nInstall = ActiveDocument.FormFields("Gebäude").Result & " - " & ActiveDocument.FormFields("ObjNr").Result
    nEqui = ActiveDocument.FormFields("EquiNr").Result
    nTyp = ActiveDocument.FormFields("Typ").Result & "-" & ActiveDocument.FormFields("TypAdd1").Result & "-" & ActiveDocument.FormFields("TypAdd2").Result
    nPTB = ActiveDocument.FormFields("PTB").Result
    nSNR = ActiveDocument.FormFields("SNR").Result
    nFFA = ActiveDocument.FormFields("FFA").Result & " x " & ActiveDocument.FormFields("SW").Result & " / " & ActiveDocument.FormFields("ZWL").Result & " / " & ActiveDocument.FormFields("WR").Result
    nPMBAR = ActiveDocument.FormFields("PMBAR").Result
    nVMBAR = ActiveDocument.FormFields("VMBAR").Result
    nPVDTNG = ActiveDocument.FormFields("PVDTNG").Result
    nVVDTNG = ActiveDocument.FormFields("VVDTNG").Result
    nMWRKST = ActiveDocument.FormFields("MWRKST").Result
    nMedium = ActiveDocument.FormFields("Medium").Result
     
    xlWBook.Application.Cells(nRow, 2).Value = ActiveDocument.FormFields("Gebäude").Result & " - " & ActiveDocument.FormFields("ObjNr").Result
    xlWBook.Application.Cells(nRow, 2).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 3).Value = ActiveDocument.FormFields("EquiNr").Result
    xlWBook.Application.Cells(nRow, 3).HorizontalAlignment = xlCenter
    If ActiveDocument.FormFields("TypAdd1").Result = "" Then
    xlWBook.Application.Cells(nRow, 4).Value = ActiveDocument.FormFields("Typ").Result & "-" & ActiveDocument.FormFields("TypAdd2").Result
    xlWBook.Application.Cells(nRow, 4).HorizontalAlignment = xlCenter
    Else
    xlWBook.Application.Cells(nRow, 4).Value = ActiveDocument.FormFields("Typ").Result & "-" & ActiveDocument.FormFields("TypAdd1").Result & "-" & ActiveDocument.FormFields("TypAdd2").Result
    xlWBook.Application.Cells(nRow, 4).HorizontalAlignment = xlCenter
    End If
    xlWBook.Application.Cells(nRow, 7).Value = ActiveDocument.FormFields("PTB").Result
    xlWBook.Application.Cells(nRow, 7).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 9).Value = ActiveDocument.FormFields("SNR").Result
    xlWBook.Application.Cells(nRow, 9).HorizontalAlignment = xlCenter
    If ActiveDocument.FFNEIN.Value = True Then
    xlWBook.Application.Cells(nRow, 8).Value = "-"
    xlWBook.Application.Cells(nRow, 8).HorizontalAlignment = xlCenter
    Else
    xlWBook.Application.Cells(nRow, 8).Value = ActiveDocument.FormFields("FFA").Result & " x " & ActiveDocument.FormFields("SW").Result & " / " & ActiveDocument.FormFields("ZWL").Result & " / " & ActiveDocument.FormFields("WR").Result
    xlWBook.Application.Cells(nRow, 8).HorizontalAlignment = xlCenter
    End If
    xlWBook.Application.Cells(nRow, 13).Value = ActiveDocument.FormFields("PMBAR").Result
    xlWBook.Application.Cells(nRow, 13).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 14).Value = ActiveDocument.FormFields("VMBAR").Result
    xlWBook.Application.Cells(nRow, 14).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 15).Value = ActiveDocument.FormFields("PVDTNG").Result
    xlWBook.Application.Cells(nRow, 15).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 16).Value = ActiveDocument.FormFields("VVDTNG").Result
    xlWBook.Application.Cells(nRow, 16).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 17).Value = ActiveDocument.FormFields("MWRKST").Result
    xlWBook.Application.Cells(nRow, 17).HorizontalAlignment = xlCenter
    xlWBook.Application.Cells(nRow, 18).Value = ActiveDocument.FormFields("Medium").Result
    xlWBook.Application.Cells(nRow, 18).HorizontalAlignment = xlCenter
    If ActiveDocument.ComboBox1.Text = "Armatur funktionssicher instandgesetzt." Then
        xlWBook.Application.Cells(nRow, 11).Value = "OK"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(34, 139, 34)
    End If
     
    If ActiveDocument.ComboBox1.Text = "Weitere Maßnahmen erforderlich. (siehe Text)" Then
        xlWBook.Application.Cells(nRow, 11).Value = "Beanstandet"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Interior.Color = RGB(255, 255, 0)
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(0, 0, 0)
    End If
     
    If ActiveDocument.ComboBox1.Text = "Wartung nicht möglich. (siehe Text)" Then
        xlWBook.Application.Cells(nRow, 11).Value = "ohne Wartung"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Interior.Color = RGB(255, 0, 0)
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(0, 0, 0)
    End If
         
    If ActiveDocument.ComboBox1.Text = "Altarmatur - Zulassung zurückgezogen! (siehe Text)" Then
        xlWBook.Application.Cells(nRow, 11).Value = "Altarmatur"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Interior.Color = RGB(255, 0, 0)
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(0, 0, 0)
    End If
     
    If ActiveDocument.ComboBox1.Text = "Altarmatur - Zulassung eingeschränkt! (siehe Text)" Then
        xlWBook.Application.Cells(nRow, 11).Value = "Altarmatur"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(34, 139, 34)
    End If
         
    If ActiveDocument.ComboBox1.Text = "Altarmatur - Zulassung eingeschränkt ! (siehe Text)" Then
        xlWBook.Application.Cells(nRow, 11).Value = "Altarmatur"
        xlWBook.Application.Cells(nRow, 11).HorizontalAlignment = xlCenter
        xlWBook.Application.Cells(nRow, 11).Interior.Color = RGB(255, 255, 0)
        xlWBook.Application.Cells(nRow, 11).Font.Color = RGB(0, 0, 0)
    End If
     
 
   For Each rng In ActiveSheet.UsedRange
      If IsEmpty(rng) Then rng.Delete xlShiftUp
   Next rng
   Application.ScreenUpdating = True
   xlWBook.Close SaveChanges:=True
 
     
End Sub

Der untere Teil "For Each rng..." soll die überflüssigen Zeilen löschen anschließend speichern und schließen.

Eventuell weiss jemand Rat wie ich es anstellen kann das das Makro nur die usedRange Einträge löscht, die sich unterhalb der Zeile befinden welche durch das Makro beim speichern ausgelesen und übertragen werden. Ich hoffe ich habe mein Problem ausreichend und verständlich genug geschildert und würde mich sehr freuen wenn sich jemand einmal damit beschäftigt und mir eventuell weiterhelfen kann.

 

Gruß

Manuel

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Problem mit Excel Makro um leere Zellen zu löschen
 29.08.2014 08:51:31 Manuel
NotSolved