Код VBA для циклического перебора столбцов на основе даты начала и окончания месяца - PullRequest
0 голосов
/ 07 ноября 2019

Я надеюсь, что смогу хорошо объяснить свои требования к макросам.

В основном это 5 столбцов. Col A - имя ресурса, Col B - роль, Col C - дата начала месяца, Col D - дата окончания месяца, Col E - процент. Пожалуйста, смотрите прикрепленное изображение для четкого изображения. ! [введите описание изображения здесь] [3]

Код: он просто печатает первый слот (первый месяц - пол. EFG)!

Dim A1, A2, A3, A4, A5 As Range
Dim i As Integer
Range("A5").Select

i = ActiveCell.Row
j = ActiveCell.Column

 While (ActiveCell.Value <> "Null")
    Set A1 = Nothing
    Set A2 = Nothing
    Set A3 = Nothing
    Set A4 = Nothing
    Set A5 = Nothing

        If (Range("P" & i).Value) > 0 Then

            Set A1 = Range("C" & i)   ' Role
            Set A2 = Range("A" & i)   ' Resource Name
            Set A3 = UpdateStartDate(i) ' Start Date
            Set A4 = UpdateEndDate(i)   ' End Date
            Set A5 = UpdatePercent(i)   ' Percentage

            Call TransferData(A1, A2, A3, A4, A5)

Else


        End If

 i = i + 1
 Range("A" & i).Select

Wend

End Sub

Sub TransferData(A1, A2, A3, A4, A5 As Range)

Dim i As Integer
i = ActiveCell.Row

    Range("R" & i).Value = A1    'Role
    Range("S" & i).Value = A2    'Resource Name
    Range("T" & i).Value = A3    'Start
    Range("U" & i).Value = A4    'End
    Range("V" & i).Value = A5    'Percentage

End Sub



Function UpdateStartDate(ByVal i As Integer) As Range
Dim j As Integer
Dim A3 As Range
Range("E" & i).Select
j = ActiveCell.Column
While (ActiveCell.Value = 0)
    j = j + 4
    Cells(i, j).Select
Wend
Set UpdateStartDate = Cells(2, j)

End Function

Function UpdateEndDate(ByVal i As Integer) As Range
Dim j As Integer
Dim A4 As Range
Range("G" & i).Select
j = ActiveCell.Column
While (ActiveCell.Value = 0)
    j = j + 4
    Cells(i, j).Select
Wend
Set UpdateEndDate = Cells(2, j)
End Function

Function UpdatePercent(ByVal i As Integer) As Range
Dim j As Integer
Dim A5 As Range
Range("G" & i).Select
j = ActiveCell.Column
While (ActiveCell.Value = 0)
    j = j + 4
    Cells(i, j).Select
Wend
Set UpdatePercent = Cells(i, j)
End Function 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...