Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

erweiterte Suchfunktion in Excel

Betrifft: erweiterte Suchfunktion in Excel von: Stefan
Geschrieben am: 18.06.2014 11:12:19

Habe jetzt folgendes gemacht. Eine Schaltfläche "Suchen" eingefügt.

Diese hat folgendem Code

Sub suchen()
Dim rngFind As Range
Dim strTitel As String
'suchdialog kreieren
strTitel = InputBox("Suche nach:", "Suchbegriff eingeben", , 5, 5)
'zu durchsuchenden spaltenumfang angeben
Set rngFind = Columns("A:H").Find(strTitel, LookIn:=xlFormulas)
'zur stelle springen oder message ausgeben
If Not rngFind Is Nothing Then
rngFind.Select
Else
MsgBox "Es wurde nichts gefunden"
End If
End Sub jetzt muss ich es eigentlich nur schaffen das er in einem anderen Tabellenblatt in bestimmten Zelle sucht. und dann wie in diesem Code eigentlich alles kopiert und altes löscht. Das muss irgendwie in die Suchfunktion mit eingebaut werden. Leider übersteigt es gerade etwas meine Fähigkeiten. Um eure Hilfe wäre ich sehr dankbar.
Hier ein Link zu meinem eigentlch Excel Dokument
https://www.dropbox.com/s/5ne0vmaypt7aox7/DP-Beta5.xlsm

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim intRow, lngSpalte
  If Target.Address = "$A$2" Then
      Cells(2, 2) = "Nichts Ausgewählt"
      
  ElseIf Target.Address = "$B$2" Then
      If Cells(2, 2) <> "Nichts Ausgewählt" Then
          With Sheets("Auswahl")
             intRow = 2
             'Zeilen hochzählen, bis zur 1. leeren Zeile in E:M
             Do
               'prüfen, ob Zellen in Spalten E bis M der Zeile leer sind
               If Application.WorksheetFunction.CountA(.Range(.Cells(intRow, 5), _
                         .Cells(intRow, 14))) = 0 Then
                 If intRow > 2 Then
                   Application.EnableEvents = False
                   'Inhalte und Formate im Bereich E2:Mxxx löschen
                   .Range(.Cells(2, 5), .Cells(intRow - 1, 14)).Clear
                   Application.EnableEvents = True
                 End If
                 Exit Do
               End If
               intRow = intRow + 1
             Loop
          End With
          
          For intRow = 1 To 300
              If Target.Value = Worksheets("DP").Cells(intRow, 1).Value Then
                  With Sheets("DP")
                    If .Cells(intRow, 1).MergeCells = True Then 'Zellen in Spalte A _
                        sind verbunden
                      .Range(.Cells(intRow, 2), .Cells(intRow + _
                            .Cells(intRow, 1).MergeArea.Rows.Count - 1, 10)).Copy
                    Else
                      .Range(.Cells(intRow, 2), .Cells(intRow, 10)).Copy
                    End If
                  End With
                  With Sheets("Auswahl")
                    Application.EnableEvents = False
                    .Cells(Target.Row, 5).PasteSpecial Paste:=xlPasteFormats, _
                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    .Cells(Target.Row, 5).PasteSpecial Paste:=xlPasteAll
                    Application.CutCopyMode = False
                    Application.EnableEvents = True
                  End With
                  Exit For
              End If
          Next intRow
      End If
  End If
End Sub

  

Betrifft: Button 'Zum File-Upload' nicht sichtbar? orT von: Luc:-?
Geschrieben am: 18.06.2014 15:03:34

Gruß Luc :-?