Excel, Felder aus Tabellenblatt auslesen und übereinstiummende in anderem ausgeben?

... komplette Frage anzeigen

3 Antworten

Endlich ... mal eine "gute" Frage, in der alles enthalten ist, was man zum Antworten benötigt (aktuelle Situation, Problembeschreibung, Ziel), sogar die Rechtschreibung ist beachtet. Daumen hoch.

Die Antwort von Sharrky lässt keinen Bezug zur Frage erkennen.

Iamiam hat mal wieder den Nagel auf den Kopf getroffen.
Allerdings hätte er sich den Hinweis auf den Blattnamen sparen können (steht in der Frage: Blatt 1: Customer, Blatt 2: Market

Also empfehle ich als Formel
=SVERWEIS(A2;Market!A:B;2;0)

Gruß aus Berlin

Antwort bewerten Vielen Dank für Deine Bewertung

hmmm

ich schick dir mal mein code was ich gerade mache vilt. hilft der dir weiter ist so ähnlich. Kann auch sein das er dir 0 hilft.

Private Sub CommandButton1_Click()
Range("J11:Z6000").Delete
Application.DisplayAlerts = False

Dim varDatei As Variant

varDatei = Application.GetOpenFilename()
If varDatei = False Then
MsgBox "Der Benutzer hat abgebrochen.", vbInformation
GoTo ende:
Else
MsgBox "Folgende Datei wurde ausgewählt:" & vbCrLf & varDatei
End If

Dim wbZiel As Workbook
Dim wbQuelle As Workbook

Set wbZiel = ThisWorkbook
Set wbQuelle = Workbooks.Open(varDatei)

wbQuelle.Sheets(1).UsedRange.Copy
wbZiel.Sheets(1).Cells(10, 1).PasteSpecial xlPasteValues

wbQuelle.Close
Application.DisplayAlerts = True
ende:
End Sub

Private Sub CommandButton2_Click()

Sheets("Tabelle2").Range("A1:Z999").Clear

Rows(13).Copy Destination:=Tabelle2.Rows(3)

If Cells(12, 1) = "Auftrag:" Then GoTo fehler

Dim baufs As Double
baufs = 0
Dim aaufs As Double
aaufs = 0
Dim summe As Double
summe = 0
Dim volumen As Double
volumen = 0
Dim bauf As Integer
bauf = 0
Dim aauf As Integer
aauf = 0
Dim beginn As Integer
beginn = 14
Dim volz As Integer
Dim p As Double
volz = 0
Dim d1 As Double
d1 = 0
Dim d2 As Double
d2 = 0
Dim d As Double
d = 0
Dim a As Integer
a = 4
d1 = CLng(CDate(Cells(9, 2)))
d2 = CLng(CDate(Cells(9, 4)))

Do
If CheckBox1.Value = True Then GoTo keindatum:
d = CLng(CDate(Cells(beginn, 1)))

If d >= d1 And d <= d2 Then

keindatum:

summe = summe + Cells(beginn, 8)

Rows(beginn).Copy Destination:=Tabelle2.Rows(a)
a = a + 1

If Cells(beginn, 2) = 1 Then
volz = volz + 1
volumen = volumen + Cells(beginn, 8)
End If

If Cells(beginn, 2) = 2 Or Cells(beginn, 2) = 8 Then
bauf = bauf + 1
baufs = baufs + Cells(beginn, 8)
End If

If Cells(beginn, 2) = 7 Then
aauf = aauf + 1
aaufs = aaufs + Cells(beginn, 8)
End If
End If

beginn = beginn + 1
Loop While IsEmpty(Cells(beginn, 1).Value) = False

Range("J4") = "Anzahl:" & "(" & beginn - 14 & ")"

Range("J5") = beginn - 14
Range("K5") = Format(summe, "Currency")

Range("J6") = volz
Range("K6") = Format(volumen, "Currency")

Range("J7") = bauf
Range("K7") = Format(baufs, "Currency")

Range("J8") = aauf
Range("K8") = Format(aaufs, "Currency")

p = Cells(5, 10) / 100
Cells(7, 12) = Round(Cells(7, 10) / p, 2)
Cells(8, 12) = Round(Cells(8, 10) / p, 2)

MsgBox " Status" & vbNewLine & " v Wieviele" & vbNewLine & " v" & vbNewLine & "Angebote Gesamt: (......)" & " (" & beginn - 14 & ")" & " = " & Format(summe, "Currency") & vbNewLine & "Angebot Status: ( 1 ) " & " (" & volz & ")" & " = " & Format(volumen, "Currency") & vbNewLine & "Bereits Aufträge: (2,8)" & " (" & bauf & ") = " & Format(baufs, "Currency") & vbNewLine & "Abgelehnt: ( 7 )" & " (" & aauf & ") = " & Format(aaufs, "Currency") & vbNewLine & vbNewLine & "Drücken sie STRG+C um es in der Zwischenablage zu Speichern"

fehler:
If Cells(12, 1) = "Auftrag:" Then
MsgBox "Es Handelt sich um eine Nachkalkulation! Benutzen sie den Nachkalkulation Button."

End If

End Sub

Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub Rechnung_Click()

If Cells(13, 1) = "Pos_Angebotsdatum" Then GoTo fehler

Rem __________________________
Rem Wertigkeit
Rem __________________________
Dim Vorrs As Double
Dim Vorr As Integer
Dim Lasts As Double
Dim Last As Integer
Dim Rechs As Double
Dim Rech As Integer
Dim Ersts As Double
Dim Erst As Integer
Dim summes As Double
Dim summe As Integer
Dim Autos As Double
Dim Auto As Integer
Dim beginn As Integer

Rem __________________________
Rem Variablen
Rem __________________________
Vorrs = 0
Vorr = 0
Lasts = 0
Last = 0
Rechs = 0
Rech = 0
Ersts = 0
Erst = 0
summes = 0
summe = 0
beginn = 13

Do
If Cells(beginn, 3) = 2 Or Cells(beginn, 3) = 8 Then
If Cells(beginn, 4) = 3 Then
summes = summes + Cells(beginn, 13)
summe = summe + 1

If Cells(beginn, 2) = "V" Then
Vorrs = Vorrs + Cells(beginn, 13)
Vorr = Vorr + 1
End If
If Cells(beginn, 2) = "L" Then
Lasts = Lasts + Cells(beginn, 13)
Last = Last + 1
End If
If Cells(beginn, 2) = "R" Then
Rechs = Rechs + Cells(beginn, 13)
Rech = Rech + 1
End If
If Cells(beginn, 2) = "E" Then
Ersts = Ersts + Cells(beginn, 13)
Erst = Erst + 1
End If
If Cells(beginn, 2) = "A" Then
Autos = Autos + Cells(beginn, 13)
Auto = Auto + 1
End If
End If
End If

Cells(beginn, 12) = Cells(beginn, 11).Value * 62

beginn = beginn + 1

Loop While IsEmpty(Cells(beginn, 1).Value) = False

Range("F4") = Format(summes, "Currency")

Range("F5") = Format(Vorrs, "Currency")

Range("F6") = Format(Lasts, "Currency")

Range("F7") = Format(Rechs, "Currency")

Range("F8") = Format(Ersts, "Currency")

Range("F9") = Format(Autos, "Currency")

Cells(4, 7) = summe
Cells(5, 7) = Vorr
Cells(6, 7) = Last
Cells(7, 7) = Rech
Cells(8, 7) = Erst
Cells(9, 7) = Auto

MsgBox Cells(1, 1) & vbNewLine & vbNewLine & "Gesamt-Gewinn: " & "(" & summe & ") " & Format(summes, "Currency") & vbNewLine & "Vorrichtungen: " & " (" & Vorr & ") " & Format(Vorrs, "Currency") & vbNewLine & "Lastaufnahmen:" & " (" & Last & ") " & Format(Lasts, "Currency") & vbNewLine & "Rechnungen: " & " (" & Rech & ") " & Format(Rechs, "Currency") & vbNewLine & "Erstangebot: " & " (" & Erst & ") " & Format(Ersts, "Currency") & vbNewLine & "Automation: " & " (" & Auto & ") " & Format(Autos, "Currency") & vbNewLine & vbNewLine & Cells(beginn + 2, 1) & vbNewLine & vbNewLine & " Bei 62€ Basissatz." & vbNewLine & vbNewLine & "Drücken sie STRG+C um es in der Zwischenablage zu Speichern"

fehler:

If Cells(13, 1) = "Pos_Angebotsdatum" Then
MsgBox "Es Handelt sich um eine KPI! Benutzen sie den KPI Button."
End If

End Sub

Antwort bewerten Vielen Dank für Deine Bewertung
Kommentar von Pucky99
21.07.2016, 14:44

Das ist mit einem einfachen Sverweis zu lösen

1

=SVERWEIS(A2;A:B;2;0)


für zeile zwei, A:B musst du in Blatt 1 wählen. Einfach in die formel an die stelle und dann Spalte A bis B markieren

Antwort bewerten Vielen Dank für Deine Bewertung
Kommentar von Iamiam
21.07.2016, 19:27

ja, wenn man weiß, wie man zum Markieren externer Bereiche mit der Maus umgeht.

Ansonsten:
=SVERWEIS(A2;Blatt2!A:B;2;0)

Blatt2 heißt vermutlich anders(?), richtigen Namen einsetzen und ! nicht vergessen!

Diese Formel runterziehen.

Falls zu begrenzen, Zeilen vor dem runterziehen $ setzen:
=Wennfehler(SVERWEIS(A2;Blatt2!A$2:B$800;2;0);"-")

Wenn die möglicherweise vielen Fehlermeldungen stören, einbetten in Wennfehler():

=Wennfehler(SVERWEIS(A2;Blatt2!A:B;2;0);"-")

statt des "-" auch jedes andere Zeichen: "☹" oder gar nichts ""

1

Was möchtest Du wissen?