Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1588to1592
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
Inhaltsverzeichnis

Verschiede Texte finden und Werte in Zelle schreib

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

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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)

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige