Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
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

Excel Bug? kennt das jemand?

Excel Bug? kennt das jemand?
28.08.2015 10:40:35
Thomas
Hallo Excelfreunde,
die beispieldatei ist zur zeit ca. 50kb gross. Wenn ich das Macro darin gleich starte ( es werden nur spalten kopiert) wird die Datei ca. 25 MB gross. Ich komme nicht auf das problem. Wenn ich von der Tabelle Auswertung erst die Formate mit dem Pinsel in die Temp kopiere und danach das macro starte bleibt die datei 50 kB ? ich bin völlig ratlos. Lösche ich in beiden Tabellen die Formate bleibt es auch bei den 50k.
Ich teste schon seid zwei Tagen?
Diesen Fall habe ich zweimal in der Hauptdatei mist mit 50 MB kann ich nicht händeln.
Kennt jemand dieses Problem von Excel? Oder ist es eins was ich mir gelegt habe.
Um die Datei klein zu halten muss ich erst alle formate in Temp löschen dann mit dem Pinsel die Formate von Auswertung nach temp machen. Wenn ich jetzt das Makro starte bleibt die Datei klein? Habe ich mich verrannt?
liebe grüsse thomas
https://www.herber.de/bbs/user/99870.xlsm

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Bug? kennt das jemand?
28.08.2015 11:08:18
selli
hallo thomas,
in solchen fällen empfiehlt es sich hier erstmal nur den betreffenden code einzustellen.
ich weiss nicht wie andere das sehen, aber ich öffne nur ungern dateien die schon als verbugt beschrieben werden.
gruß
selli

AW: Excel Bug? kennt das jemand?
28.08.2015 11:30:58
Thomas
Hallo Selli,
super das du Dir dies mal anschaust. ich habe den code aus der datei rausgenommen siehe unten.
In dieser beispieldatei ist der Code auch nicht mehr drinn. Die datei ist aber sauber ich habe sie
nur als demonstration neu erstellt. Sie ist weder aus dem netz oder so ( ist auch kein virus ich benutze eine bez. version vo bitdefender.) Aber wie schon gesagt diese datei hat noch kein anderen rechner gesehen. . Ich finde es super das du mir den hinweis gegeben hast sonst hätte sich wahrscheinlich aus Sicherheitsgründen niemand angeschaut. Ich könnte mir schon vorstellen wenn man den Code anders schreibt das dann dieses problem umschifft werden kann. Nur wüsste ich selbst nicht wie.
liebe grüsse thomas
https://www.herber.de/bbs/user/99872.xlsm
Sub KOPIEREN()
'

Public Sub bestimmte_Spalten_Kopieren_Temp_KOM()
Dim lastColumn As Integer
Dim wbFrom As Workbook
Dim wsFrom As Worksheet
Dim wsTo As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
'Dim C1 As Range
On Error GoTo ErrExit
Dim rng As Range
'Dim loDeinWert As Long
Dim S1 As Range
Dim S2 As Range
Dim S3 As Range
Dim S4 As Range
Dim S5 As Range
Dim S6 As Range
Dim S7 As Range
Dim S8 As Range
Dim S9 As Range
Dim Suchwert1 As String
Dim Suchwert2 As String
Dim Suchwert3 As String
Dim Suchwert4 As String
Dim Suchwert5 As String
Dim Suchwert6 As String
Dim Suchwert7 As String
Dim Suchwert8 As String
Dim Suchwert9 As String
Suchwert1 = "Test1"
Suchwert2 = "Test2"
Suchwert3 = "Test3"
Suchwert4 = "Test4"
Suchwert5 = "Test5"
Suchwert6 = "Test6"
Suchwert7 = "Test7"
Suchwert8 = "Test8"
Suchwert9 = "Test9"
Application.StatusBar = "Bitte warten ich arbeite"
Sheets("temp").Range("G1").Clear
'Sheet, in das die Daten eingefügt werden
Set wsTo = ActiveWorkbook.Sheets("temp")
'Datendatei öffnen und letzte verwendete Spalte ermitteln
Set wbFrom = ActiveWorkbook
Set wsFrom = wbFrom.Sheets("Auswertung")
lastColumn = Sheets("Auswertung").Cells(10, Columns.Count).End(xlToLeft).Column
With Worksheets("Auswertung").Range("a10:az10") ' Cells(10, Columns.Count).End(xlToLeft) '
'Erste Suche
Set S1 = .Find(Suchwert1, LookIn:=xlValues)
If Not S1 Is Nothing Then
Set S2 = .Find(Suchwert2, LookIn:=xlValues)
If Not S2 Is Nothing Then
Set S3 = .Find(Suchwert3, LookIn:=xlValues)
If Not S3 Is Nothing Then
Set S4 = .Find(Suchwert4, LookIn:=xlValues)
If Not S4 Is Nothing Then
Set S5 = .Find(Suchwert5, LookIn:=xlValues)
If Not S5 Is Nothing Then
Set S6 = .Find(Suchwert6, LookIn:=xlValues)
If Not S6 Is Nothing Then
Set S7 = .Find(Suchwert7, LookIn:=xlValues)
If Not S7 Is Nothing Then
Set S8 = .Find(Suchwert8, LookIn:=xlValues)
If Not S8 Is Nothing Then
Set S9 = .Find(Suchwert9, LookIn:=xlValues)
If Not S9 Is Nothing Then
Worksheets("temp").Range("b10:k100000").ClearContents  '  Formatierung bleibt stehen
'Worksheets("temp").Range("b11:ZZ10000").EntireRow.Delete '  Formatierung mit löschen   _
EntireRow.Delete
' wsTo.Cells.Clear
'alle verwendeten Spalten durchlaufen und überprüfen,
'ob Wert in erster Zelle einem gesuchten Wert entspricht
'wenn ja, Spalte kopieren
For i = 1 To lastColumn      '  die Zahl ist die spalte
Select Case wsFrom.Cells(10, i).Text
Case Suchwert1
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(1).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert2
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(2).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert3
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(3).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert4
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(4).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert5
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(5).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert6
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(6).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert7
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(7).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert8
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(8).Cells(2, 2).PasteSpecial xlPasteAll
Case Suchwert9
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(9).Cells(2, 2).PasteSpecial xlPasteAll
End Select
Next
Application.ScreenUpdating = True
End If
End If
End If
End If
End If
End If
End If
End If
End If
'MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Sheets("Tabelle2").Range("G1").Value = " Alles ok"
End With
'Application.Wait Now + TimeValue("00:00:05")
Application.StatusBar = "Bin fertig alles ok"
Application.StatusBar = False
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'Fehler im Modul  _
bestimmte_Spalten_Kopieren_in_TEMP_KOM'" & vbLf & String(60, "_") & vbLf & vbLf & _
IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
_
.Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation +  _
_
vbMsgBoxSetForeground, "VBA - Fehler in Prozedur - daten"
.Clear
End If
End With
Application.ScreenUpdating = True
On Error GoTo 0
Application.CutCopyMode = False               '   Speicher leeren
ClearClipboard = True                         ' Speicher leern
End
End Sub

Anzeige
AW: Excel Bug? kennt das jemand?
28.08.2015 15:26:30
Thomas
hallo,
ich kann dies Problem mit der Veränderung unten umschiffen.
aber interessant bleibt es auf jedenfall. Wenn ich mal was dazu finde melde ich mich noch mal.
auf jedenfall vielen dank für jeden der sich damit beschäftigt hat. Eine Idee zur Codverbesserung nehme ich natürlich gern da er ja ziemlich lang geworden ist.
Aber da es jetzt funktioniert schließe ich dies erstmal. Denke ich.
liebe grüsse thomas
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(1).Cells(2, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige