Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
832to836
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
832to836
832to836
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchmakro funktioniert kann aber zu viel

Suchmakro funktioniert kann aber zu viel
03.01.2007 17:01:40
michael
Sagt man im Forum Guten Tag
und bringt ein lächeln mit und gute Laune
dann hofft der michael der kleine
das man ihm helfe ,denn er schafft es nicht alleine.
Ich habe ein Suchmakro das funktioniert aber es kann zu viel
Es kopiert ALLES – sollte aber nur die WERTE kopieren.
könnt ihr mir bitte helfen.
Danke michael.

Sub Suchen1()
Dim Suchtext As String
Dim Zelle As Range
Dim i As Long
Dim j As Integer
Dim KopierteZeilen()
Dim NeueMappe As Worksheet
Dim Arbeitsmappe As String
Dim Schon_da As Boolean
Suchtext = InputBox(" " & Chr(10) & " " & Chr(10) & "Wonach suchen wir ?", "                            der kleine michael", "Eingabe")
If Suchtext <> "" Then
Arbeitsmappe = ActiveWorkbook.Name
Workbooks.Add
Set NeueMappe = ActiveWorkbook.ActiveSheet
i = 2
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Suchergebniss"
Workbooks(Arbeitsmappe).Activate
Rows("1:1").Copy NeueMappe.Cells(1, 1)
For Each Zelle In Workbooks(Arbeitsmappe).ActiveSheet.UsedRange
If InStr(1, Zelle.Value, Suchtext, vbTextCompare) > 0 Then
ReDim Preserve KopierteZeilen(i - 2)
Schon_da = False
For j = 0 To UBound(KopierteZeilen)
If KopierteZeilen(j) = Zelle.Row Then Schon_da = True
Next
If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy NeueMappe.Cells(i, 1)
i = i + 1
End If
End If
Next
NeueMappe.Activate
Columns("A:H").EntireColumn.AutoFit
Range("A1").Select
End If
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchmakro funktioniert kann aber zu viel
03.01.2007 17:23:48
fcs
Hallo Michael,
passe folgende Zeilen an:

entweder
If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy
NeueMappe.Cells(i, 1).PasteSpecial Paste:=xlPasteValues
i = i + 1
End If
oder
If Not Schon_da Then
NeueMappe.Cells(i, 1).Range("A1:IV1").Value = _
Cells(Zelle.Row, 1).Range("A1:IV1").Value
i = i + 1
End If

Gruß
Franz
Danke mein fehler,jetzt etwas zu wenig
03.01.2007 17:56:04
michael
Hallo Franz
Danke für deine Hilfe , mein Fehler bei der Fragestellung war
das ich nicht bedacht habe das in Spalte A ein Datum steht.zb. 10.05.
Format TT.MM
und jetzt natürlich eine Zahl.
Ich kann zwar ganze Spalte Selectieren und Format Ändern,
aber falls sich das ins Makro einbinde lässt wehre schon fein.
wenn möglich bitte nochmals helfen
Danke michael
Anzeige
AW: Danke mein fehler,jetzt etwas zu wenig
03.01.2007 20:09:02
fcs
Hallo Michael,
neuere Excelversioen könne mit PasteSpecial auch das Zahlen-Format mit den Werten in einem Befehl kopieren

If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy
NeueMappe.Cells(i, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
i = i + 1
End If
oder du kopierst erst die Zellformate und dann die Werte
If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy
NeueMappe.Cells(i, 1).PasteSpecial Paste:=xlPasteFormats
NeueMappe.Cells(i, 1).PasteSpecial Paste:=xlPasteValues
i = i + 1
End If
Ansonsten kannst du nach der AutoFit-Befehlszeile auch folgedende Zeile zur
Datumsformatierung der Spalte A einfügen
Columns("A:H").EntireColumn.AutoFit
Columns(1).NumberFormat = "DD.MM"

Gruss
Franz
Anzeige
AW: Danke für die Hilfe und die Nachhilfe.owT
04.01.2007 03:49:54
michael
.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige