Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
18.05.2015 10:03:32 |
Hamudi.d |
|
|
Problemsuche bei Datenauswertung in Excel. Wie gehe ich vor? |
18.05.2015 16:27:57 |
Gast28454 |
|
|
|
18.05.2015 16:45:01 |
Gast28454 |
|
|
Von:
Gast28454 |
Datum:
18.05.2015 16:27:57 |
Views:
523 |
Rating:
|
Antwort:
|
Thema:
Problemsuche bei Datenauswertung in Excel. Wie gehe ich vor? |
Man könnte es so angehen:
(hier gilt: A & B ungleich B & A ... wobei A und B jeweils Abladestationen sind)
Option Explicit
Sub Bsp()
'>> EDIT >>
Const C_SRC_NAME = "Tabelle1"
Const C_DEST_NAME = "Tabelle2"
Const C_SRC_COLUMN = "A" 'zu betrachtende Spalte in der Quelle
Const C_DEST_CELLANCHOR = "A1" 'Anker im Ziel, von dem die Daten ausgehend geschrieben werden
'<< EDIT <<
Dim rngSrc As Excel.Range
Dim rngDest As Excel.Range
Dim rngResult As Excel.Range
Dim strAblst As String
Dim strNr As String
Dim idxRowO As Long 'Zeilen-Versatz
Dim idxColO As Long 'Spalten-Versatz
Dim idx As Long
'Anker für Bereiche
With Worksheets(C_SRC_NAME)
Set rngSrc = .Cells(1, C_SRC_COLUMN)
End With
With Worksheets(C_DEST_NAME)
Call .UsedRange.Delete
Set rngDest = .Range(C_DEST_CELLANCHOR)
End With
'Formatierungen der Ausgabe (Kopfspalte/-zeile)
With rngDest.EntireRow
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
With rngDest.EntireColumn
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
With rngSrc.Worksheet
'relevanten Bereich in Spalte referenzieren
Set rngSrc = .Range(rngSrc, .Cells(.Rows.Count, rngSrc.Column).End(xlUp))
End With
idx = 1
Do Until idx > rngSrc.Cells.Count And Len(rngSrc.Cells(idx).Text) = 0
If Len(rngSrc.Cells(idx).Text) >= 9 Then
'LKW-Nr.
strNr = rngSrc.Cells(idx).Text
idxRowO = idxRowO + 1
rngDest.Offset(idxRowO).Value = strNr
Else
'LKW-Abladestation
If (idx + 1) <= rngSrc.Cells.Count Then
'..noch innerhalb des Bereichs
If Len(rngSrc.Cells(idx + 1).Text) < 9 Then
'Abladestelle (Von->Zu)
strAblst = rngSrc.Cells(idx).Text & " & " & rngSrc.Cells(idx + 1).Text
idx = idx + 1
Else
'Abladestelle (einzeln)
strAblst = rngSrc.Cells(idx).Text
End If
Else
'Abladestelle (einzeln)
strAblst = rngSrc.Cells(idx).Text
End If
Set rngResult = rngDest.Resize(, 1 + idxColO).Find(strAblst, LookIn:=xlValues, Lookat:=xlWhole)
If rngResult Is Nothing Then
idxColO = idxColO + 1
rngDest.Offset(, idxColO).Value = strAblst
With rngDest.Offset(idxRowO, idxColO)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = "x"
End With
Else
With rngDest.Offset(idxRowO, rngResult.Column - rngDest.Column)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = "x"
End With
End If
End If
idx = idx + 1
Loop
With rngDest.Offset(idxRowO + 1, 1).Resize(, idxColO)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.FormulaR1C1 = "=COUNTA(R[-" & idxRowO & "]C:R[-1]C)"
End With
End Sub
auspucken tut das Makro dann soetwas:
|
699 |
232 & 32 |
111 & 232 |
32 & 15 |
32 & 259B |
111 & 113 |
59 & 111B |
110203882 |
x |
|
|
|
|
|
|
110249679 |
|
x |
|
|
|
|
|
110249703 |
|
x |
|
|
|
|
|
110250081 |
|
|
x |
x |
x |
|
|
110250578 |
|
|
|
|
|
x |
|
110251055 |
|
|
|
|
|
x |
x |
|
1 |
2 |
1 |
1 |
1 |
2 |
1 |
Gruß
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
18.05.2015 10:03:32 |
Hamudi.d |
|
|
Problemsuche bei Datenauswertung in Excel. Wie gehe ich vor? |
18.05.2015 16:27:57 |
Gast28454 |
|
|
|
18.05.2015 16:45:01 |
Gast28454 |
|
|