Я пытаюсь скопировать ряд строк, в которых выбранные строки основаны на значении в одной ячейке. Я хочу сделать это для всех строк, содержащих одно и то же значение в ячейке, а затем перейти к следующему значению a добавьте нижнюю часть первого списка.
Ниже моя попытка объяснить, чего я хочу достичь – надеюсь, что вышеизложенное поможет объяснить мою дилемму. Я искал это, но не совсем понял, что хочу. Я думал, что это будет просто и, вероятно, есть.
Я получаю дамп данных с тысячами строк данных и 18 столбцов. Основываясь на значении столбца P “Контракт”, я хочу скопировать целые строки в новый отдельный рабочий лист workingdata. Не все данные войдут в рабочий лист workingdata.
Номера контрактов: c1234, c1235, c2345 и т.д.
То, что я получаю, – это копирование и сортировка, поэтому скопируйте все строки данных, где номер контракта – c1234, в workingdata, а затем прямо под ним скопируйте все строки, где заключен контракт c1235 и т.д.
Я думал, что могу выбрать диапазон P: P и сортировать, но безрезультатно.
Sheets("Data Dump").Select
Columns("P:P").Select
If Selection.Value = "C1234" Then
Selection.EntireRow.copy
Я знаю, что должен опубликовать то, что я пробовал, но это было бы жалко, по какой-то причине я просто не могу показаться, что обманываю это.
Здесь мое последнее усилие – я знаю, что есть ошибки
Dim oWorksheet As Excel.Worksheet
Dim oRangeSource As Excel.Range
Dim oRangeDest As Excel.Range
Set oWorksheet = Worksheets("DataDump")
Set oRangeSource = oWorksheet.Range("p:p")
Set oRangeDest = Worksheets("workingdata")
If oRangeSource="CA0004000" Then Select.EntireRow
Selection.EntireRow.copy
Sheets("workingdata").Select.Paste
End If
Последнее усилие, но не сортирует данные или не избавляется от нежелательных, я должен сделать ручной фильтр и сортировать, какие виды поражений объекта макроса
Sub copy()
'
' copy Macro
'
Dim rngContracts As Range: Set rngContracts = Sheets("DataDump").Range("P:P")
Dim wsData As Worksheet
Dim wsFound As Boolean: wsFound = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Working Data" Then
Set wsData = ws
wsFound = True
Exit For
End If
Next ws
If wsFound = False Then
Application.CutCopyMode = False
ActiveSheet.Range("A1").EntireRow.copy
Set wsData = Sheets.Add(After:=Sheets(Sheets.Count))
wsData.Name = "Working Data"
wsData.Range("A1").EntireRow.PasteSpecial xlPasteAll, Transpose:=False
End If
Dim iCell As Range
For Each iCell In rngContracts
If iCell.EntireRow.Hidden = False Then
Application.CutCopyMode = False
iCell.EntireRow.copy
wsData.Range("P" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteAll, Transpose:=False
End If
Next iCell
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Последний доступ – копирует нужные мне данные, но не сортирует:
Sub copytest()
'
' copytest Macro
'
Set MR = Sheets("data Dump").Range("P:P")
For Each cell In MR
If cell.Value = "CA000154" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
If cell.Value = "CA000220" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
If cell.Value = "CA000393" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
If cell.Value = "CA000429" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
Application.CutCopyMode = False
Next
End Sub
Записать макрос, чтобы установить фильтры в ваших данных, выберите только один фильтр.
Затем отредактируйте код и пропустите через каждый фильтр, копируя видимый диапазон на ваш лист. Это также должно сортировать ваши данные, поскольку фильтры уже отсортированы.
Также рассмотрим создание массивов фильтров в справке Excel VBA в отношении их сортировки.