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

VBA

VBA
21.01.2013 10:11:13
Michael
Hallo,
ich bräuchte bitte dringend Hilfe bei einem VBA Skript. Zur besseren Verständniss hab ich mal ein paar Datensätze in den Anhang getan..
Nun zum Problem ;) Leider wurde das Format in der Spalte N (Charge korrigiert) in einem falschen Format eingegeben, jetzt müsst ich es schaffen, dass VBA erkennt, ob ein oder mehrere Runs gelaufen sind oder nicht. er sollte dann die ganze zeile in ein neues tabellenblatt kopieren und die zeile aufsplitten - also wie folgt:
wenn in der spalte n drinsteht: 120201/R3,020212/R4,030212/R1, dann sollte er alles in das neue tabellenblatt auf 3 zeilen aufteilen..
könnte mir bitte jemand helfen? lg mike
https://www.herber.de/bbs/user/83492.xlsx

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA
21.01.2013 13:15:50
Klaus
Hi,
das sollte es tuen. Starte das Makro "KorrigiereCharge" von Hand. Starte NICHT das Makro "RekursivKorrigieren", dass muss vom anderen Makro aufgerufen werden.
Option Explicit
Sub KorrigiereCharge()
Dim wksSource As Worksheet
Dim wksTarget As Worksheet
Dim lRowLast As Long
Dim lRowTarget As Long
Set wksSource = Sheets("Tabelle1")
Set wksTarget = Sheets("Tabelle2")
wksTarget.Cells.ClearContents
RekursivKorrigieren
lRowLast = wksSource.Cells(Rows.Count, 1).End(xlUp).Row
lRowTarget = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksSource
.Range("A1").EntireRow.Copy wksTarget.Range("A1")
.Range(.Cells(2, 1), .Cells(lRowLast, 1)).EntireRow.Copy
wksTarget.Cells(lRowTarget, 1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = xlCopy
End Sub
Sub RekursivKorrigieren()
Dim wksSource As Worksheet
Dim wksTarget As Worksheet
Dim lRowLast As Long
Dim lRowTarget As Long
Dim iColCharge As Integer
Dim iColLast As Integer
Dim rCharge As Range
Dim bAgain As Boolean
Set wksSource = Sheets("Tabelle1")
Set wksTarget = Sheets("Tabelle2")
iColCharge = 14
bAgain = False
lRowTarget = wksTarget.Cells(Rows.Count, iColCharge).End(xlUp).Row
With wksSource
lRowLast = .Cells(Rows.Count, iColCharge).End(xlUp).Row
iColLast = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
For Each rCharge In .Range(.Cells(2, iColCharge), .Cells(lRowLast, iColCharge))
.Cells(rCharge.Row, iColLast).FormulaR1C1 = "=LEFT(RC[-8],FIND(""/"",RC[-8])-1)"
If IsError(.Cells(rCharge.Row, iColLast).Value) Then
Else
rCharge.EntireRow.Copy
lRowTarget = lRowTarget + 1
wksTarget.Cells(lRowTarget, 1).PasteSpecial xlPasteValues
wksTarget.Cells(lRowTarget, iColCharge).Value = wksTarget.Cells(lRowTarget,  _
iColLast).Value
bAgain = True
End If
Next rCharge
For Each rCharge In .Range(.Cells(2, iColCharge), .Cells(lRowLast, iColCharge))
If IsError(.Cells(rCharge.Row, iColLast).Value) Then
Else
.Cells(rCharge.Row, iColCharge).Value = Application.WorksheetFunction.Substitute(. _
Cells(rCharge.Row, iColCharge).Value, .Cells(rCharge.Row, iColLast) & "/", "")
End If
Next rCharge
End With
'Rekursiv aufrufen
If bAgain Then RekursivKorrigieren
End Sub
Grüße,
Klaus M.vdT.

Anzeige
keine Rückmeldung? :-(
23.01.2013 10:06:39
Klaus
Hallo Mike,
eine Rückmeldung wäre nett. Ein kurzes "Danke, passt oT" im Betreff eines leeren Beitrages reicht da schon.
Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige