Блог

Я совершенно новичок в VBA и здесь немного потерялся. У меня есть файл Excel с праздниками моих коллег. Для каждого дня года есть ячейка, в которую нужно вставить «X». Мне нужно написать макрос с помощью VBA для экспорта CSV-файла, который экспортирует их номер персонала и дату начала и окончания отпуска. Мне также нужна логика, чтобы пропустить выходные. Мне нужен файл CSV, чтобы импортировать его в Visual Planning. Это должна быть таблица с номером персонала, датой начала и датой окончания в виде столбцов Как я могу это сделать? Не могли бы вы мне помочь, пожалуйста?

 Sub Makro1()
  

‘

 Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Worksheets("2021")

Dim ersteZeile As Integer
Dim letzteZeile As Integer

Dim c As Range
Dim datumRow As Integer
Dim d As Range

datumRow = 4


ersteZeile = 5
letzteZeile = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row

anfangsRange = "I" amp; ersteZeile
endrange = "NI" amp; letzteZeile

For Each c In ws.Range("I5:NI71")
    If Not c.Value = "" Then
        Cells(4, c.Column).Copy Destination:=Sheets("CSV").Column("BEGDA")
    End If
Next c
  

Конец подраздела

Это код, который я получил до сих пор, но мне нужно динамически копировать «X» в мой CSV-лист.

Пожалуйста, попробуйте следующий код. Он создает строку, соответствующую правилу создания CSV, и помещает ее в файл в конце. Имя файла будет importEmployee.csv и оно будет найдено в книгах, содержащих этот путь к коду. Вы можете изменить путь в любом месте, которое вам нужно (в конце кода):

 Sub ExportCSVHolidayDays()
 Dim sh As Worksheet, lastRow As Long, lastCol As Long, arrPn, arrH, arrInt
 Dim i As Long, j As Long, strCSV As String, startD As String, endD As String
 Dim lngSt As Long, lngEnd As Long, arrI
 
 Set sh = ActiveSheet
 lastRow = sh.Range("A" amp; rows.count).End(xlUp).row
 lastCol = sh.cells(4, Columns.count).End(xlToLeft).Column
 
 arrPn = sh.Range("A5:A" amp; lastRow).Value
 arrH = sh.Range("H4", sh.cells(lastRow, lastCol)).Value
 
 For i = 1 To UBound(arrPn)
    arrInt = Application.Index(arrH, i   1, 0)       'extract a row slice of arrH
    arrI = Split(StrReverse(Join(arrInt, ",")), ",") 'reverse the slice array
    
     lngSt = WorksheetFunction.Match("X", arrInt, 0) 'first "X" position
    startD = arrH(1, lngSt): ' start date (from arrH first row)
     lngEnd = UBound(arrI) - WorksheetFunction.Match("X", arrI, 0)   2 'last "X" pos
    endD = arrH(1, lngEnd):  ' end date (from arrH first row)
    
    If strCSV = "" Then
        'write the first row of the CSV string - first employee
        strCSV = arrPn(i, 1) amp; "," amp; startD amp; "," amp; endD amp; vbCrLf
    Else
        'next employee first line
        strCSV = strCSV amp; arrPn(i, 1) amp; "," amp; startD amp; "," amp; endD amp; vbCrLf
    End If
        startD = "": endD = ""                            'reinitialize the variables
        For j = lngSt To lngEnd   1
            If UCase(arrInt(j)) = "X" And startD = "" Then startD = arrH(1, j)          'new start date
            If arrInt(j) = "" And endD = "" And startD <> "" Then endD = arrH(1, j - 1) 'new end date
            
            If endD <> "" Then
                'write the sequence inside the total start and end date
                strCSV = strCSV amp; arrPn(i, 1) amp; "," amp; startD amp; "," amp; endD amp; vbCrLf
            End If
            If arrInt(j) = "" Then startD = "": endD = "" 'reinitialize the variables
        Next
 Next
 'write the CSV file from string (strCSV):
 Dim expPath As String
 expPath = ThisWorkbook.Path amp; "importEmployee.csv"
 Open expPath For Output As #1
    Print #1, strCSV
 Close #1
 MsgBox "Ready..." amp; vbCrLf amp; _
        "Here you can find he CSV exported file: " amp; expPath amp; ".", _
                            vbInformation, "Finishing confirmation"
End Sub
  

Пожалуйста, отправьте отзыв после тестирования.