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

Suchen markrieren kopieren weitersuchen

Suchen markrieren kopieren weitersuchen
07.11.2003 17:33:04
Thomas
Hallo Forum!

Ich möchte in meiner Tabelle über alle Zeilen und Spalten einen Begriff suchen (Zahl oder Text). Sofern der Begriff gefunden wird soll die Zeile markiert werden und mit einer Msgbox gefragt werden ob die Zeile kopiert werden soll. Wenn ja zeile in Tabelle 2 kopieren. Danach Msgbox ob weitergesucht werden soll.
usw. gefunden kopieren.........

Kann mir da jemand helfen?

LG
Thomas

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen markrieren kopieren weitersuchen
07.11.2003 20:32:13
Nepumuk
Hallo Thomas,
ich habe mit den wenigen Informationen die du über den Tabellenaufbau preis gibst ein Programm auf Verdacht geschrieben. Beim suchen berücksichtigt es nur ganze Werte. D.h. "abcd" wird nicht in "abcde" gefunden. Des weitern wird Groß- und Kleinschreibung unterschieden. Beim kopieren wird in Tabelle 2 nachgeschaut, welche Zeile in Spalte a nicht belegt ist. In diese Zeile wird dann kopiert.


Option Explicit
Public Sub suchen()
Dim myRange As Range, strSuchbegriff As String, strAdresse As String
Dim lngZeile As Long, intSpalte As Integer, myWs As Worksheet
Set myWs = Worksheets(2)
strSuchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
If Trim(strSuchbegriff) <> "" Then
With Worksheets(1).Cells
Set myRange = .Find(What:=strSuchbegriff, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not myRange Is Nothing Then
strAdresse = myRange.Address
Do
If myRange.Column + 5 < 256 Then intSpalte = myRange.Column + 5 Else intSpalte = myRange.Column
If myRange.Row - 5 > 0 Then lngZeile = myRange.Row - 5 Else lngZeile = myRange.Row
ActiveWindow.ScrollColumn = intSpalte
ActiveWindow.ScrollRow = lngZeile
myRange.Select
Select Case MsgBox("Diese Zeile kopieren?", 35, "Abfrage")
Case 2: Exit Sub
Case 6: myWs.Range(myWs.Cells(myWs.Cells(65536, 1).End(xlUp).Row + 1, 1), _
myWs.Cells(myWs.Cells(65536, 1).End(xlUp).Row + 1, 256)) = _
Range(Cells(myRange.Row, 1), Cells(myRange.Row, 256)).Value
End Select
If MsgBox("Weitere Einträgen suchen?", 36, "Abfrage") = 7 Then Exit Sub
Set myRange = .FindNext(myRange)
Loop While Not myRange Is Nothing And myRange.Address <> strAdresse
MsgBox "Keine weiteren Einträge gefunden.", 64, "Information"
Else
MsgBox "Suchbegriff nicht gefunden.", 48, "Hinweis"
End If
End With
End If
End Sub



Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk
Anzeige
AW: Suchen markrieren kopieren weitersuchen
07.11.2003 20:56:04
Beni
Hallo Thomas,
ich habe Dir ein Beispiel angefügt.
Gruss Beni

https://www.herber.de/bbs/user/1801.xls


Sub Daten_kopieren()
Sheets(1).Select
c = Cells(1, 256).End(xlToLeft).Column
r = Cells(65536, 1).End(xlUp).Row
Titel = "InputBox"
Mldg = "Suchbegriff eingeben"
Wert = InputBox(Mldg, Titel)
If Wert = "" Then Exit Sub
For i = 1 To r
With Sheets(1).Rows(i)
Set w = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not w Is Nothing Then
vorhanden = 1
Range(Cells(i, 1), Cells(i, c)).Select
Status = MsgBox("Zeile_kopieren?", _
vbQuestion + vbYesNo, _
"Einträge löschen")
Select Case Status
Case vbYes
With Sheets(2)
Dim lRow As Long
lRow = .Cells(65536, 1).End(xlUp).Row + 1
For a = 1 To c
.Cells(lRow, a).Value = Cells(i, a).Value
Next a
End With
Case vbNo
End Select
End If
End With
Next i
If vorhanden < 1 Then MsgBox "Suchbegriff nicht vorhanden"
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige