Итерация по столбцам в рабочей таблице Excel до тех пор, пока я не найду совпадение даты для вставки значений - PullRequest
0 голосов
/ 02 мая 2019

В настоящее время я пытаюсь автоматизировать рабочий дневник коллеги по работе.

Я загружаю данные из базы данных компании в конце дня, и она преобразует их в рабочую книгу Excel (1).

Затем у меня есть макрос в отдельной книге ежедневных отчетов (2). Я использую цикл For ... Next для перебора столбцов, чтобы найти пробел, а затем вставляет скопированные значения в один из столбцов дней (например, понедельник)

Я хочу найти лучший способ найти правильный день недели, чтобы вставить мои значения. Исходя из данных, которые я копирую из нашей компании, я подумал об использовании дат в качестве справочного, чтобы найти нужный день в своей ежедневной рабочей тетради.

Dim x As Workbook, y As Workbook
OFile = "Automation_Example_Tanya.xlsm"
MsgBox "Choose the file for this day's report"
FileName = Application.GetOpenFilename
Do While FileName = False
    MsgBox ("Choose this week's report")
    FileName = Application.GetOpenFilename
Loop
Set x = Workbooks.Open(FileName)
Windows(OFile).Activate
Sheets(1).Activate
Cells.Select
Selection.Clear

    x.Activate
    x.Sheets(1).Cells.Select
    Application.CutCopyMode = False
    Selection.Copy

    Windows(OFile).Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    x.Close SaveChanges:=False

End Sub
Sub Auto_Update_Report()
    Dim NCR As Variant
    Dim x As Variant
    Application.ScreenUpdating = False
    Call OpenFilePaste
    Sheets(2).Activate
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("B2").Activate
    NCR = Range("C2:G2").Cells.Count
    For x = 1 To NCR
    ActiveCell.Offset(0, 1).Select
    If IsEmpty(ActiveCell) Then
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
           Range("A1").Activate
           Exit Sub
            Else
                If Range("G2") <> "" Then
                Range("C:F").ClearContents
                Range("A1").Activate
                Call Auto_Paste
                Exit Sub
            End If
    End If
Next x
End Sub ```
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...