Блог

У меня есть книга Excel с несколькими листами, которые загружаются данными, импортированными из нескольких внешних файлов excel. Для выполнения этого действия я успешно создал код VBA, который позволяет пользователю открывать файлы.

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

Существующие ранее данные выглядят следующим образом:

Необработанные данные после загрузки будут выглядеть следующим образом:

Как только макрос запускается, предыдущие столбцы заполняются должным образом, но поскольку последние два столбца заполняются периодически, они в конечном итоге делают это:

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

Из-за размера данных и самого макроса я хотел бы сохранить структуру кода. Тем более, что предполагается, что этот макрос будет перенесен в другие книги главной книги.

Мой макрос выглядит так (обобщено по времени):

 1. Sub Import_GL1001
2. Dim FileToOpen As Variant
3. Dim OpenBook As Workbook
4. Application.ScreenUpdating = False
5. FileToOpen=Application.GetOpenFileName(Title="Import_GL1001",FileFilter:="ExcelFiles (*xlsx*),*xlsx*")
6. If FileToOpen<> False Then
7. Set OpenBook=Application.Workbooks.Open(FileToOpen)
8. OpenBook.Sheets(1).Range("$A$2:$A$1500").Copy
9. ThisWorkbook.Worksheets("GL 1001.10").Range("A"amp;Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
10. OpenBook.Sheets(1).Range("$B$2:$B$1500").Copy
11. ThisWorkbook.Worksheets("GL 1001.10").Range("B"amp;Rows.Count).End(xlUp).Offset(1,0).PasteSpecialxlPasteValues
12. ......
13. OpenBook.Sheets(1).Range("$AC$2:AC$1500").Copy
14. ThisWorkbook.Worksheets("GL 1001.10").Range("AD"amp;Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPastevalues
15. OpenBook.Sheets(1).Range("$AD$2:$AD$1500").Copy
15. ThisWorkbook.Worksheets("GL 1001.10").Range("AF"amp;Rows.Count).End(xlUp).Offset(1,0).PasteSpecialxlPasteValues
 

В идеальном мире значения копировались бы и вставлялись как есть, пробелы и все такое, поэтому при запуске макроса в будущем два рассматриваемых столбца не меняют положение в зависимости от последней пустой ячейки. Я пробовал несколько методов и вариантов, но единственная логичная вещь, которую я мог бы придумать, — это если мне удастся найти способ вставить «0» в каждую пустую ячейку при каждом импорте данных, не изменяя все пустые ячейки (т. Е. Если у нас только 30 строк данных, я не хочу, чтобы все пустые ячейки в AF:AF были «0»). Если ячейки вообще имеют значение, то это означает, что сам макрос не придется кардинально перестраивать.

Пожалуйста, попробуйте следующий способ:

1. Последняя строка, в которую нужно вставить значения, должна быть рассчитана только один раз, на основе известного вам столбца, который все время заполняется значениями.

 Dim lastERow As Long, sh As Worksheet

Set sh = ThisWorkbook.Worksheets("GL 1001.10")
lastERow = sh.Range("A" amp; sh.Rows.Count).End(xlUp).Offset(1,0).row 'last empty row
 

2. Затем используйте эту ссылку для всех столбцов, в которые вы собираетесь вставлять, начиная с одной и той же пустой строки ячейки:

 'your existing code
OpenBook.Sheets(1).Range("$A$2:$A$1500").Copy
sh.Range("A" amp; lastERow).PasteSpecial xlPasteValues
'...
'...
OpenBook.Sheets(1).Range("$AC$2:AC$1500").Copy
sh.Range("AD" amp; lastERow).PasteSpecial xlPastevalues
OpenBook.Sheets(1).Range("$AD$2:$AD$1500").Copy
sh.Range("AF" amp; lastERow).PasteSpecial xlPastevalues
 

Таким образом, код будет вставляться, начиная с одной и той же пустой строки, во все столбцы.

Если вы хотите следовать своему способу решения, пожалуйста, запустите следующий код, но после запуска существующего кода. Он возьмет ссылку из последней заполненной ячейки столбца A:A:

 Sub ZeroInEmptyCells()
  Dim sh As Worksheet, lastRow As Long, rngEmpt As Range
  
  Set sh = ThisWorkbook.Worksheets("GL 1001.10")
  lastRow = sh.Range("A" amp; sh.rows.count).End(xlUp).row 'last row in column A:A
  
  On Error Resume Next 'if no empty cells, the next code line will return an error (without this line...):
   Set rngEmpt = Union(sh.Range("AD1:AD" amp; lastRow), sh.Range("AF1:AF" amp; lastRow)).SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 If Not rngEmpt Is Nothing Then rngEmpt.value = 0
End Sub