wenn If Bedingung nicht zutrifft
15.08.2019 16:29:57
Georg
For i = 2 To lngLetzte
If .Cells(i, 3).Value = strSk1 Then
Was folgt sind Sverweise, was ich aber nicht umgesetzt kriege ist, dass wenn die Bedingung nicht zutrifft, dass dann auch keine SVERWEIS Formeln drin stehen, was der Code aber macht; er schreibt in jede Zelle die Formeln. Kurz gesagt, die Zelle soll einfach leer bleiben. Wo liegt mein Denkfehler?
VIELEN DANK!!G
Sub TeilC1()
Dim strFilename
Dim strFilter As String
Dim strDateiname As String
Dim lngLetzte As Long
Dim Monat As String
Dim strSk1 As String
strSk1 = "Skill 1 BSD"
Dim strTL As String
strTL = "TL BSD"
'----------------------------------------------------------------------------------------------- _
Dim wbNeu As Workbook
Set wbNeu = Workbooks.Add
ThisWorkbook.Activate
ws.Move Before:=wbNeu.Worksheets(1)
ThisWorkbook.Activate
ThisWorkbook.Save
MsgBox ("Die Vorlage wurde ohne die aktuellen Daten gespeichert und kann wieder verwendet _
werden!")
wbNeu.Activate
'----------------------------------------------------------------------------------------------- _
Dim wbSk1 As Workbook
MsgBox ("Es wird nun die Skill-Datei mit den Stunden geöffnet, wählen Sie die passende aus!")
'DateiÖffnen Dialog
strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Q"
ChDir "Q:\Geschäftsführung\Organisationsentwicklung\40_Organisationsentwicklung\ _
Excel_Weiterentwicklungen\Bereich_GF"
strFilename = Application.GetOpenFilename(strFilter)
Set wbSk1 = Workbooks.Open(strFilename)
wbSk1.Activate
Dim lgRowSk1 As Long
'lgRowSk1 = wbSk1.Worksheets(2).Cells(.Rows.Count, 1).End(xlUp).Row
Dim strwbSk1 As String
strwbSk1 = wbSk1.name
'----------------------------------------------------------------------------------------------- _
wbNeu.Activate
Application.ScreenUpdating = False
With wbNeu.Worksheets(1)
lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lngLetzte
If .Cells(i, 3).Value = strSk1 Then
'KVB Stunden
.Range(.Cells(2, 6), .Cells(lngLetzte, 6)).FormulaR1C1 = _
"=IfError(VLOOKUP(RC[-1],[" & strwbSk1 & "]Neu!R2C2: _
R50000C7,4,FALSE),"""")"
'Ikk Stunden
.Range(.Cells(2, 7), .Cells(lngLetzte, 7)).FormulaR1C1 = _
"=IfError(VLOOKUP(RC[-2],[" & strwbSk1 & "]Neu!R2C2: _
R50000C7,5,FALSE),"""")"
'116117 Stunden
.Range(.Cells(2, 8), .Cells(lngLetzte, 8)).FormulaR1C1 = _
"=IfError(VLOOKUP(RC[-3],[" & strwbSk1 & "]Neu!R2C2: _
R50000C7,6,FALSE),"""")"
'Formatieren
.Range(.Cells(2, 6), .Cells(lngLetzte, 8)).NumberFormat = " _
0.00"
'Gesamtstunden
.Range(.Cells(2, 9), .Cells(lngLetzte, 9)).FormulaR1C1 = _
"=sum(RC[-3]:RC[-1])"
'formatieren
.Range(.Cells(2, 9), .Cells(lngLetzte, 9)).NumberFormat = " _
0.00"
End If
Next i
End With
Application.ScreenUpdating = True
'----------------------------------------------------------------------------------------------- _
Application.DisplayAlerts = False
wbSk1.Activate
wbSk1.Close
Monat = Application.InputBox("Geben Sie den Monat ein!")
ChDrive "Q:\"
ChDir "Q:\Geschäftsführung\Organisationsentwicklung\40_Organisationsentwicklung\ _
Excel_Weiterentwicklungen\Bereich_GF"
strDateiname = ("PKosten_BT_Skills" & Monat & "_" & "2019.xlsx")
wbNeu.SaveAs (strDateiname)
Application.DisplayAlerts = True
End Sub