VBA Weitergabe eines Textes
15.09.2015 10:14:42
Roffel89
ich benötige nochmals Hilfe und zwar soll in der Zeile wo mein Tool "Fall 4" reinschreibt in die nächste Spalte noch eine Beschreibung zu dem Fall automatisch auftauchen. Ich komme nicht drauf, wie ich das hinbekomme.
Weiß das jemand?
Ich übergebe ja den String ("Fall 4"): summary = checkList(sheet, 13, "Fall 4")
Und dann beginnt meine Funktion zu arbeiten und schreibt alle zutreffenden Ereignisse unter Fall 4. Was es auch tun soll. Ich will jetzt nur noch das in der Kopfzeile, in der nächsten Spalte noch ein String mit einer Erklärung zu dem Fall hinzugefügt wird.
Public Sub testClient()
Dim sheet As String
'sheet selector
sheet = "30112015"
'Summary Zeile mit Datum und Anzahl der Datensätze
Dim summary As Integer
summary = checkList(sheet, 13, "Fall 4")
summary = summary + checkList(sheet, 12, "Fall 3")
summary = summary + checkList(sheet, 11, "Fall 2")
summary = summary + checkList(sheet, 10, "Fall 1")
Call newLineAndFormat
Sheets("Summary").Cells(15, 2).Value = "=TODAY()"
Sheets("Summary").Cells(15, 6).Value = summary
Sheets("Summary").Activate
End Sub
Function checkList(sheet As String, caseColumn As Integer, Optional label As String = "") As Integer
Dim currentRow As Long
Dim counter As Integer
'Checking List
For currentRow = Sheets(sheet).Cells.SpecialCells(xlLastCell).Column To 2 Step -1
If (Sheets(sheet).Cells(currentRow, caseColumn).Value = "True" Or _
Sheets(sheet).Cells(currentRow, caseColumn).Value = "Wahr") Then
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = Sheets(sheet).Cells(currentRow, 1).Value
counter = counter + 1
End If
Next currentRow
'Summary row
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = label
Sheets("Summary").Cells(15, 6).Value = counter
Sheets("Summary").Activate
checkList = counter
End Function
Private Sub newLineAndFormat()
Sheets("Summary").Activate
Sheets("Summary").Rows("15:15").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Summary").Range("16:16").Copy
Sheets("Summary").Rows("15:15").PasteSpecial Paste:=xlPasteFormats
Sheets("Summary").Range("B15").Select
Application.CutCopyMode = False
End Sub
VG
Anzeige