Supportnet / Forum / Tabellenkalkulation

Hi ! Also, ich habe zwei Listen in Excel. Eine befindet sich im "Tabelle1" Spalte A und die andere in "Tabelle2" Spalte A. Diese sollen verglichen werden und identische Namen makieren. Diese Fragestellung wurde schonmal behandelt. Dort wurde folgende Lösung gegeben: " Hallo, kopiere nachfolgenden Code in den Codebereich einer Befehlsschaltfläche: [b]Option Explicit Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim lzeile&, x&, i&, sel$ Worksheets("Tabelle2").Select lzeile = Range("A65535").End(xlUp).Row Worksheets("Tabelle1").Select For x = 1 To Range("A65535").End(xlUp).Row For i = 1 To lzeile If Range("A" & CStr(x)).Value = Worksheets("Tabelle2").Range("A" & CStr(i)).Value Then sel = sel & "A" & CStr(x) & "," End If Next Next sel = Left(sel, (Len(sel) - 1)) Range(sel).Select Application.ScreenUpdating = True End Sub [/b] TabellenNamen und Spalten müßten Deinen Gegebenheiten entsprechend angepasst werden. " Da ich mich aber nicht besonders mit Excel auskenne, scheitere ich schon am Code einfügen in einer Befehlsschaltfläche. Wäre nett wenn mir einer kurz Schritt nach Schritt erklären könnte, wo ich das einfügen muss und wie ich auf ein Ergebnis komme. Vielen Dank, Niko

Hallo

Lies ´mal die Antwort 12 in diesem Thread https://supportnet.de/threads/1345633
und auch Anleitungen auf www.excelbeispiele.de

Gruß[h3]{[h1]^Ó_¤[sup...fürLau

hi all :)

hier eine variante

gruss nighty

Rem obere menueleiste freie stelle suchen/rechtsclick/steuerelement-toolbox/entwurfsmodus ein
Rem befehlsschaltflaeche anwaehlen/positionieren/rechtsclick/code anzeigen/code dort mittig einfuegen
Rem bei der steuerelent-toolbox entwurfsmodus beenden anwaehlen
Rem fertig

Sheets(2).Select
Range("A1").Select
Sheets(1).Select
Range("A1").Select
Dim BereichEins As String
Dim BereichZwei As String
Dim zeile As Long
Dim suche As Range
For zeile = 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche = Sheets(2).Range("A1" & ":A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row). _
Find(Sheets(1).Range("A" & zeile), LookIn:=xlValues)
If Not suche Is Nothing Then
BereichEins = BereichEins & suche.Address(0, 0) & ","
BereichZwei = BereichZwei & suche.Address(0, 0) & ","
End If
Next zeile
BereichEins = Mid(BereichEins, 1, Len(BereichEins) - 1)
BereichZwei = Mid(BereichZwei, 1, Len(BereichZwei) - 1)
Sheets(1).Range(BereichEins).Select
Sheets(2).Select
Range(BereichZwei).Select
Sheets(1).Select

hi all :)

wie immer korrigiert :)

gruss nighty

Sheets(2).Select
Range("A1").Select
Sheets(1).Select
Range("A1").Select
Dim BereichEins As String
Dim BereichZwei As String
Dim zeile As Long
Dim suche As Range
For zeile = 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche = Sheets(2).Range("A1" & ":A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row). _
Find(Sheets(1).Range("A" & zeile), LookIn:=xlValues)
If Not suche Is Nothing Then
BereichEins = BereichEins & Range("A" & zeile).Address(0, 0) & ","
BereichZwei = BereichZwei & suche.Address(0, 0) & ","
End If
Next zeile
BereichEins = Mid(BereichEins, 1, Len(BereichEins) - 1)
BereichZwei = Mid(BereichZwei, 1, Len(BereichZwei) - 1)
Sheets(1).Range(BereichEins).Select
Sheets(2).Select
Range(BereichZwei).Select
Sheets(1).Select

hi all :)

zwar nur eine schleife aber mit hang zur zweideutigkeit und die ersteren selectionen gefallen mir auch net so recht die aber fuer eine darauffolgende zweite suche wichtig sind.

also noch verbesserungwuerdig :)))

gruss nighty

Das werde ich dann erstmal alles ausprobieren.

Vielen Dank für schnelle Hilfe !

Niko

hi all :)

oder auf zelle a wie b bezogen somit weniger zweideutiger waere :)

gruss nighty

Dim zaehler1 As Long
Dim suche1 As Range
Dim suche2 As Range
Dim bereicheins As String
Dim bereichzwei As String
Sheets(2).Select
Range("A1").Select
Sheets(1).Select
Range("A1").Select
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche1 = Sheets(2).Range("A1" & ":A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2).Find(Sheets(1).Range("A" & zaehler1))
Set suche2 = Sheets(2).Range("B1" & ":B" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2).Find(Sheets(1).Range("B" & zaehler1))
If Not suche1 Is Nothing And Not suche2 Is Nothing Then
If suche1.Row = suche2.Row And Sheets(1).Range("A" & zaehler1) <> "" And Sheets(1).Range("B" & zaehler1) <> "" _
And Sheets(1).Range("A" & zaehler1) = Sheets(2).Range("A" & suche1.Row) And _
Sheets(1).Range("B" & zaehler1) = Sheets(2).Range("B" & suche2.Row) Then
bereicheins = bereicheins & Range("A" & zaehler1).Address(0, 0) & ","
bereichzwei = bereichzwei & suche1.Address(0, 0) & ","
End If
End If
Next zaehler1
bereicheins = Mid(bereicheins, 1, Len(bereicheins) - 1)
bereichzwei = Mid(bereichzwei, 1, Len(bereichzwei) - 1)
Sheets(1).Range(bereicheins).Select
Sheets(2).Select
Range(bereichzwei).Select
Sheets(1).Select

hi all :)

die addressen der selectierungen werden ja in einem string gespeichert der schnell die erlaubte laenge ueberschreiten koennte,sollte es zu einer fehlermeldung kommen,wuerde ich eine andere variante vorschlagen,wie z.b. farbmarkierungen oder kommentarfelder usw.

gruss nighty

hi all :)

hier eine bessere loesung,in diesem beispiel info im kommentarfeld einer zelle

gruss nighty

Option Explicit
Sub suchen()
Sheets(1).Range("A1:A65535").ClearComments
Sheets(2).Range("A1:A65535").ClearComments
Dim BereichEins As String
Dim BereichZwei As String
Dim zeile As Long
Dim suche As Range
For zeile = 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche = Sheets(2).Range("A1" & ":A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row). _
Find(Sheets(1).Range("A" & zeile), LookIn:=xlValues)
If Not suche Is Nothing Then
If Sheets(1).Range("A" & zeile) = Sheets(2).Range(Sheets(2).Cells(suche.Row, 1), Sheets(2).Cells(suche.Row, 1)) _
And Sheets(1).Range("A" & zeile) <> "" Then
Sheets(1).Cells(zeile, 1).AddComment
Sheets(1).Cells(zeile, 1).Comment.Text Text:="Sheet 1 Zeile " & zeile & Chr(10) & "Sheet 2 Zeile " & suche.Row
Sheets(1).Cells(zeile, 1).Comment.Visible = False
Sheets(2).Cells(suche.Row, 1).AddComment
Sheets(2).Cells(suche.Row, 1).Comment.Text Text:="Sheet 1 Zeile " & zeile & Chr(10) & "Sheet 2 Zeile " & suche.Row
Sheets(2).Cells(suche.Row, 1).Comment.Visible = False
End If
End If
Next zeile
End Sub

• problem mit javascript einfügen!!!
• beliebiege Anzahl zeilen einfügen vba
• Excel-Datei in einem Exceltabellenblatt als Symbol einfügen
• Excel: Befehlsschaltfläche einfügen "Speichern und senden als anhang"