Код для вставки данных на основе соответствия строк и столбцов Условие значения

Question

У меня есть два листа tabs.i.e. Исходные данные и обзор

Я искал код, который будет копировать и вставлять данные на вкладке «Обзор» на основе имен в столбце B и датах в строке 3: 3.

В таблице на вкладке Сырые данные имена в колонке А, даты в колонке B и значение в столбце C

В таблице Обзор выглядит следующим образом

01/04/2015 02/04/2015 03/04/2015 04/04/2015 05/04/2015 

б
гр
d

Я понимаю, что существуют такие формулы, как Vlookups, Index, sumifs, но я бы предпочел soluti on в VBA, так как данные обширны.

Answer 1

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

Для запуска этого кода вы должны проверить и изменить имена рабочих листов в двух строках кода, начиная с «Установить» и изменить индексы индекса столбца и строки в соответствии с вашими потребностями.

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

Sub DoYourJob() 

Dim x As Integer 
Dim y As Integer 
Dim z As Integer 

Dim sourceWorksheet As Worksheet 
Dim targetWorksheet As Worksheet 

Set sourceWorksheet = ThisWorkbook.Worksheets("YourSourceWorksheetName") 
Set targetWorksheet = ThisWorkbook.Worksheets("YourTargetWorksheetName") 

Dim existing As Boolean 
'Let the macro read an create the table 

'Creating the rows 
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row 
    existing = False 
    For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row 
     If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(x, 1).Value Then 
      existing = True 
      Exit For 
     End If 
    Next y 
    If Not existing Then 
     targetWorksheet.Cells(targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = sourceWorksheet.Cells(x, 1).Value 
    End If 
Next x 

'Creating the columns 
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row 
    existing = False 
    For y = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column 
     If targetWorksheet.Cells(1, y).Value = sourceWorksheet.Cells(x, 2).Value Then 
      existing = True 
      Exit For 
     End If 
    Next y 
    If Not existing Then 
     targetWorksheet.Cells(1, targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column + 1).Value = sourceWorksheet.Cells(x, 2).Value 
    End If 
Next x 

'Iterate to fill the table 
For z = 1 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row 
    For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row 
     If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(z, 1).Value Then 
      For x = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column 
       If targetWorksheet.Cells(1, x).Value = sourceWorksheet.Cells(z, 2).Value Then 
        targetWorksheet.Cells(y, x).Value = sourceWorksheet.Cells(z, 3).Value 
        Exit For 
       End If 
      Next x 
      Exit For 
     End If 
    Next y 
Next z 

End Sub 

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