Mittels eines Makros werden die Daten aus einer Excel-Tabelle in ein csv-File umgewandelt. Jetzt ist es so, dass die Personen aus dem Stamm unter dem Tabellenblatt mehrere Datensätze haben. Diese sollten im Export alle aufsummiert werden.
Anbei sende ich Euch mal den Code für die Aufbereitung der Daten.
Für Eure Hilfe bedanke ich mich im Voraus.
Gruss
NXM
' Daten für Schnittstellendatei aufbereiten
Worksheets("Import").Range("A2").Select
z = 2 ' Zeilennummer für Schnittstellenprotokoll
Do Until IsEmpty(ActiveCell.Value)
h = ActiveCell.Row
pName = Mid(Cells(h, 1).Value, InStrRev(Cells(h, 1).Value, " ") + 1)
pBetrag = Str(Round(Cells(h, 2).Value * 100, 0))
Worksheets("Stamm").Activate
mEndZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Stamm").Range("A2:A" & mEndZeile)
Set c = .Find(pName, LookIn:=xlValues, SearchOrder:=xlByColumns)
If Not c Is Nothing Then
firstAddress = c.Address
Do
a = c.Row
mName = Cells(a, 1).Value
mPersNr = Cells(a, 3).Value
mAnstNr = Cells(a, 4).Value
mKlinik = Cells(a, 5).Value
' Datensatz für Schnittstellenfile aufbereiten
t1 = String(8 - Len(Trim(mPersNr)), "0") + Trim(mPersNr)
t2 = String(2 - Len(Trim(mAnstNr)), "0") + Trim(mAnstNr)
t3 = "1886"
't4 Betrag auf Negativwert prüfen
If InStr(1, pBetrag, "-") = 0 Then
t4 = String(13 - Len(Trim(pBetrag)), "0") + Trim(pBetrag)
Else: t4 = "-" + String(13 - Len(Trim(pBetrag)), "0") _
+ Mid(Trim(pBetrag), 2, Len(Trim(pBetrag)) - 1)
End If
t5 = "CHF"
t6 = Trim(Str(pBegDatum))
t7 = "1100"
t8 = "5130"
t9 = " HOGE " & Trim(mKlinik)
t10 = Trim(mName)
t11 = """"
t12 = "Total"
't13 Totalbetrag auf Negativwert prüfen
If InStr(1, pSumBetrag, "-") = 0 Then
t13 = String(13 - Len(Trim(pSumBetrag)), "0") + Trim(pSumBetrag)
Else: t13 = "-" + String(13 - Len(Trim(pSumBetrag)), "0") _
+ Mid(Trim(pSumBetrag), 2, Len(Trim(pSumBetrag)) - 1)
End If
t14 = Trim(Str(mAnzRecords))
' Datensatz in Schnittstellenfile schreiben
Write #1, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14
' Datensatz in Schnittstellenprotokoll schreiben
Worksheets("PULS-Protokoll").Activate
Cells(z, 1).Value = "'" + t1
Cells(z, 2).Value = "'" + t2
Cells(z, 3).Value = "'" + t3
Cells(z, 4).Value = "'" + t4
Cells(z, 5).Value = t5
Cells(z, 6).Value = "'" + t6
Cells(z, 7).Value = "'" + t7
Cells(z, 8).Value = "'" + t8
Cells(z, 9).Value = t9
Cells(z, 10).Value = t10
Cells(z, 11).Value = ""
Cells(z, 12).Value = t12
Cells(z, 13).Value = "'" + t13
Cells(z, 14).Value = "'" + t14
z = z + 1 ' Zeilennummer in Protokoll erhöhen
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With