Verschiede Texte finden und Werte in Zelle schreib

Forumthread: Verschiede Texte finden und Werte in Zelle schreib

02.11.2017 11:41:59

Christian

Hallo liebes Forum,
ich habe folgendes Problem:
In einer Exceltabelle mit dem Tabellenblatt Rechnungen habe ich in verschiedenen Spalten "Nebenkosten"(NK1-NK5). Diese sind in Text und in einem Wert (Euro) vorhanden. Zum Beispiel steht in Zelle A2 Versicherung und in Zelle B2 steht der Preis (zum Beispiel 5 Euro). Jetzt kommt mein Problem. Ich habe fünf verschiedene Nebenkosten (Versicherung - Maut - Diesel - Express - Korrektur). Diese sind aber nicht immer vorhanden und auch nicht immer in der gleichen Reihenfolge.
Ich möchte, dass diese Nebenkosten nach der jeweiligen Nebenkostenart durchsucht werden und der jeweilige Eurowert (in der rechts daneben liegenden Zelle) in eine bestimmte Spalte (z.B. D2) im Tabellenblatt Nebenkosten eingetragen wird.
Ziel:
Spaltenbezeichnung in A1 (Tabellenblatt Nebenkosten)
Versicherung | Maut | Diesel | Express | Korrektur
5 | 10 | 2,70 | 0,00 | 0,00
0,00 | 10 | 2,70 | 0,00 | 2,50
5 | 10 | 0,00 | 15,00 | 0,00
5 | 10 | 2,70 | 0,00 | 0,00
Wie kann ich das machen? Vielen Dank an alls Fleißigen!!!
Datei Nebenkostenproblem hab ich mal hochgeladen. Danke
https://www.herber.de/bbs/user/117380.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Verschiede Texte finden und Werte in Zelle schreib

02.11.2017 14:11:55

Peter(silie)

Hallo,
hier deine Mappe: https://www.herber.de/bbs/user/117385.xlsm
Hier nur Code:


Option Explicit
Private Rechnungen As Worksheet
Public Sub abc()
Dim maut(), diesel(), versicherung(), korrektur(), express() As Variant
Dim i, ii, lCol, lRow As Long
Dim counter1, counter2, counter3, counter4, counter5 As Long
Set Rechnungen = ThisWorkbook.Sheets("Rechnung")
With Rechnungen
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 1 To lCol Step 2
lRow = Last_Row(i)
For ii = 2 To lRow
If .Cells(ii, i).Value = "Maut" Then
ReDim Preserve maut(counter1)
maut(counter1) = Cells(ii, i + 1).Value
counter1 = counter1 + 1
ElseIf .Cells(ii, i).Value = "Diesel" Then
ReDim Preserve diesel(counter2)
diesel(counter2) = Cells(ii, i + 1).Value
counter2 = counter2 + 1
ElseIf .Cells(ii, i).Value = "Versicherung" Then
ReDim Preserve versicherung(counter3)
versicherung(counter3) = Cells(ii, i + 1).Value
counter3 = counter3 + 1
ElseIf .Cells(ii, i).Value = "Korrektur" Then
ReDim Preserve korrektur(counter4)
korrektur(counter4) = Cells(ii, i + 1).Value
counter4 = counter4 + 1
ElseIf .Cells(ii, i).Value = "Express" Then
ReDim Preserve express(counter5)
express(counter5) = Cells(ii, i + 1).Value
counter5 = counter5 + 1
End If
Next ii
Next i
End With
With ThisWorkbook.Sheets("Nebenkosten")
.Range("A2").Resize(UBound(versicherung) + 1).Value = (Application.Transpose( _
versicherung))
.Range("B2").Resize(UBound(maut) + 1).Value = (Application.Transpose(maut))
.Range("C2").Resize(UBound(diesel) + 1).Value = (Application.Transpose(diesel))
.Range("D2").Resize(UBound(korrektur) + 1).Value = (Application.Transpose(korrektur))
.Range("E2").Resize(UBound(express) + 1).Value = (Application.Transpose(express))
End With
End Sub
Private Function Last_Row(ByVal OfColumn As Long) As Long
With Rechnungen
Last_Row = .Cells(.Rows.Count, OfColumn).End(xlUp).Row
End With
End Function

AW: Verschiede Texte finden und Werte in Zelle schreib

02.11.2017 14:23:48

Christian

Hallo Peter(silie),
wofür braucht man Superhelden? Man braucht nur Leute wie Dich, die einem so geil helfen können. Vielen Dank!! Auch an alle Anderen. Ihr seit super

Ich fühle mich geehrt :) ..owt

02.11.2017 14:59:33

Peter(silie)

Variablendeklaration

02.11.2017 17:19:47

Nepumuk

Hallo Peter,
deine Deklarationen sind nicht richtig.
Dim counter1, counter2, counter3, counter4, counter5 As Long
Damit deklarierst du counter5 als Long alle anderen als Variant.
Richtig wäre:
Dim counter1 As Long, counter2 As Long, counter3 As Long, counter4 As Long, counter5 As Long
Ich hab das schon öfters gesehen und frage mich immer woher die Leute so etwas haben. In keiner mir bekannten Programmiersprache genügt es nur einen Datentyp per Zeile mit mehreren Variablen anzugeben.
Gruß
Nepumuk

AW: Verschiede Texte finden und Werte in Zelle schreib

03.11.2017 08:12:57

Christian

Hallo Nepumuk, Hallo Peter(silie),
ich hoffe, dass Ihr online seid, da Ihr das Problem ja schon kennt. Mein Chef findet es auch toll, wie das Problem gelöst wurde. Er hat sich leider nur falsch ausgedrückt. Er möchte, dass die Nebenkosten die anfallen der jeweiligen Rechnung zugeordnet wird. Hier lade ich die Datei hoch, die ich gestern bekommen habe. Also, alle Nebenkosten aus der Rechnung 2017-1234 z.B. soll im Tabellenblatt "Nebenkosten" erscheinen und so weiter. Sind NK nicht erhalten in der Rechnung bleibt die Spalte leer. Jungs, ich wäre Euch tausendmal dankbar, wenn das klappen würde. Danke im Vorraus. Christian
https://www.herber.de/bbs/user/117406.xlsm

AW: Verschiede Texte finden und Werte in Zelle schreib

03.11.2017 09:18:41

Peter(silie)

Hallo,
hier deine Mappe mit anderen Code: https://www.herber.de/bbs/user/117411.xlsm
(Button in Nebenkosten Tabelle)
Hier nur Code:

Option Explicit
Private Rechnung As Worksheet
Private Nebenkosten As Worksheet
Public Sub ReOrder()
Dim varKey As Variant, varItem As Variant
Dim lRow As Long, lCol As Long, i As Long
Dim tmp_1() As String, tmp_2() As String
Dim dict As Dictionary
Dim rng As Range
Set Rechnung = ThisWorkbook.Sheets("Rechnung")
Set Nebenkosten = ThisWorkbook.Sheets("Nebenkosten")
lRow = Last_Row(Rechnung, 1)
lCol = Last_Column(Rechnung)
With Rechnung
Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))
End With
Set dict = Rechnungs_Dictionary(rng)
i = 2
lCol = Last_Column(Nebenkosten)
With Nebenkosten
Set rng = .Range(.Cells(1, 1), .Cells(1, lCol))
For Each varKey In dict.Keys
.Cells(i, 1).Value = varKey
tmp_1 = Split(dict(varKey), "\")
For Each varItem In tmp_1
If varItem  vbNullString And Len(varItem) > 1 Then
tmp_2 = Split(varItem, ";")
lCol = Match_Key(tmp_2(0), rng)
If lCol > 0 Then .Cells(i, lCol).Value = CDbl(tmp_2(1))
Erase tmp_2
End If
Next varItem
i = i + 1
Erase tmp_1
Next varKey
End With
Set dict = Nothing
Set Rechnung = Nothing
Set Nebenkosten = Nothing
End Sub
Private Function Rechnungs_Dictionary(ByRef rng As Range) As Dictionary
Dim key_ As String, item_ As String
Dim lRow As Long, lCol As Long
Dim dict_1 As New Dictionary
For lRow = 2 To rng.Rows.Count
key_ = rng.Cells(lRow, 1).Value
dict_1.Add key_, vbNull
For lCol = 2 To rng.Columns.Count Step 2
If InStr(1, item_, key_, vbTextCompare) = 0 Then
item_ = item_ & rng.Cells(lRow, lCol).Value
item_ = item_ & ";" & rng.Cells(lRow, lCol + 1).Value & "\"
End If
Next lCol
If dict_1.Exists(key_) Then dict_1(key_) = item_
item_ = ""
Next lRow
Set Rechnungs_Dictionary = dict_1
Set dict_1 = Nothing
End Function
Private Function Last_Column(ByRef OfSheet As Worksheet) As Long
With OfSheet
Last_Column = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
End Function
Private Function Last_Row(ByRef OfSheet As Worksheet, ByVal OfColumn As Long) As Long
With OfSheet
Last_Row = .Cells(.Rows.Count, OfColumn).End(xlUp).Row
End With
End Function
Private Function Match_Key(ByVal key_ As Variant, rng As Range) As Long
With Application
If Not VBA.IsError(.Match(key_, rng, 0)) Then
Match_Key = .Match(key_, rng, 0)
End If
End With
End Function

AW: Verschiede Texte finden und Werte in Zelle schreib

03.11.2017 11:11:44

Christian

Hallo Peter(silie)
Was soll ich noch sagen? HAMMER. Danke. Wenn ich für Dich auch mal einen Code schreiben soll... HaHaHa...
Aber echt großen Dank...
Christian

Freut mich und danke für Rückmeldung...owt

03.11.2017 14:21:05

Peter(silie)

Beliebteste Forumthreads (12 Monate)

Verschiede Texte finden und Werte in Zelle schreib

Forumthread: Verschiede Texte finden und Werte in Zelle schreib

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Verschiede Texte finden und Werte in Zelle schreib

Forumthread: Verschiede Texte finden und Werte in Zelle schreib

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread