Доброго всем дня. Есть код. появилась необходимость его немного модернизировать (в VBA ничего не понимаю). Вкратце: код консолидирует данные из разных щитов в один согласно названиям колонок в главном щите. Так как в некоторых листах нет колонок с заданным названием я бы хотел чтобы код проставлял следующий текст "N/R" вместо пробелов (сейчас код так работает) сам код
Код
Sub SS_WP_UpDateData()
Sheets("Weekly_Plan_Sites").Select
Range("A2").Select
Dim i As Long, j As Long, k As Long, n As Long, wData As Worksheet, _
Process(1 To 5) As String, iProc As Long, Dict As Object
Process(1) = "Sheet1"
Process(2) = "Sheet2"
Process(3) = "Sheet3"
Process(4) = "Sheet4"
Process(5) = "Sheet5"
Set wData = Sheets("Weekly_Plan_Sites")
Set Dict = CreateObject("Scripting.Dictionary")
With wData
.UsedRange.Offset(1).Clear
For j = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If Len(.Cells(1, j)) > 0 Then Dict.Add LCase$(.Cells(1, j)), j
Next j
End With
i = 2
For iProc = 1 To 5
With Sheets(Process(iProc))
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If Dict.exists(LCase$(.Cells(1, j))) Then
k = Dict(LCase$(.Cells(1, j)))
.Cells(2, j).Resize(n - 1).Copy wData.Cells(i, k).Resize(n - 1)
End If
Next j
End With
i = i + n - 1
Next iProc
End Sub
Казанский, спасибо огромное! интересный подход. вначале думал нужно как-то в цикл вставить, а оказалось можно в конце все пустоты заменить. P.S. я бы в любом случае код не написал
хорошего дня!
Опыт и практика - великое дело! Век живи, Век учись!
Я посмотрел результат и увидел что код немного перевыполняет задачу. Проблема в том что он просто заменяет все пустоты текстом "N/R" вместо того чтобы ставить "N/R" только в случае с отсутствуюшей колонкой. Ддля теста можно убрать часть (не все) значение во втором листе и посмотреть результат. Думаю что нужно немного менять догику начального кода хотя как это сделать я не знаю...
MasterTofel, кстати да. Я на радостях, что все заработало, не обратил на это внимание... Поэтому и у меня изначально была логика, что нужно как-то цикл видоизменить. Казанский, можно ли как-то это сделать?
Опыт и практика - великое дело! Век живи, Век учись!
Sub SS_WP_UpDateData()
Sheets("Master").Select
Range("A2").Select
Dim i As Long, j As Long, k, n As Long, wData As Worksheet, _
Process(1 To 3) As String, iProc As Long
Process(1) = "Sheet2"
Process(2) = "Sheet3"
Process(3) = "Sheet4"
Set wData = Sheets("Master")
wData.UsedRange.Offset(1).Clear
i = 2
For iProc = 1 To 3
With Sheets(Process(iProc))
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 1 To wData.Cells(1, wData.Columns.Count).End(xlToLeft).Column
k = Application.Match(wData.Cells(1, j), .Rows(1), 0)
If IsError(k) Then
wData.Cells(i, j).Resize(n - 1) = "N/R"
Else
.Cells(2, k).Resize(n - 1).Copy wData.Cells(i, j).Resize(n - 1)
End If
Next j
End With
i = i + n - 1
Next iProc
End Sub