Я работаю над задачей, в которой я получаю календарь для человека в определенном формате, как показано ниже:
Лист1
Столбец А - Дата
Колонка B - Расположение
Колонка C - Дата отъезда (в текстовом формате 10 января 2017 года 10:00 утра)
Колонка D - Дата прибытия (в текстовом формате 10 января 2017 года 10:00 утра)
Колонка E - Новое местоположение
Колонка F - Примечания
Задачи, которые мне нужно выполнить, перечислены ниже:
- Копировать данные Sheet1 в Sheet2
- При копировании данных мне нужно вставить строки на основе следующих критериев
Если столбец C Дата отъезда и столбец D Дата прибытия находятся в одном и том же дне, вставьте новую строку со значениями, приведенными ниже:
Столбец A - та же дата, что и в строке выше
Столбец B - новое местоположение из столбца E согласно строке выше
Колонка С - ПУСТО
колонка D - ПУСТО
Колонка E - ПУСТО
Колонка F - ПУСТОЙ
Если столбец C Дата отъезда и столбец D Дата прибытия - это разные даты, нет необходимости вставлять строки, следуйте той же последовательности, что и данные из Листа 1.
Я использовал приведенный ниже код, но столкнулся с двумя проблемами, указанными ниже:
-Этот код работает только на Листе1. Можете ли вы помочь мне добавить это в Sheet2, чтобы я мог получить Sheet1 с исходными данными и Sheet2 с нужными мне результатами?
- Кроме того, приведенный ниже код использует текст «ВСТАВИТЬ» в качестве критерия. Я хочу изменить это, чтобы прочитать Столбец C и Столбец D, и если даты совпадают, то добавьте новую строку ниже даты. (ПОЖАЛУЙСТА, ПОМНИТЕ, что КОЛОННА C И КОЛОННА D ИМЕЮТ ДАТЫ В ФОРМАТЕ ТЕКСТА, ПОЭТОМУ МЫ МОЖЕМ ИСПОЛЬЗОВАТЬ ЛЕВУЮ ФУНКЦИЮ, ПРЕДЛАГАЕМУЮ МОИМИ ДРУЗЬЯМИ ЗДЕСЬ)
Private Sub CommandButton1_Click()
Dim wksData As Worksheet
Dim lngLastRow As Long, lngIdx As Long, _
lngDateCol As Long, _
lngReversalCol As Long, _
lngLocationCountryCol As Long, _
lngDestinationCountryCol As Long, _
lngDepartureDateCol As Long, _
lngArrivalDateCol As Long, _
lngNotesCol As Long
Dim varRowNum As Variant
Dim colRowNumsForInsert As Collection
Set colRowNumsForInsert = New Collection
'Set references up-front
lngDateCol = 1
lngLocationCountryCol = 2
lngDepartureDateCol = 3
lngArrivalDateCol = 4
lngDestinationCountryCol = 5
lngNotesCol = 6
Set wksData = ThisWorkbook.Worksheets("Sheet1")
lngLastRow = LastOccupiedRowNum(wksData)
'Loop through the data range BACKWARDS, tracking each case where a row will need to be in a collection
With wksData
For lngIdx = lngLastRow To 2 Step -1
'If the Notes Column = "INSERT", though, we also need 'to note that row number so we can eventually add a new row there
If .Cells(lngIdx, lngNotesCol) = "INSERT" Then
colRowNumsForInsert.Add Item:=lngIdx, Key:=CStr(lngIdx)
End If
Next lngIdx
'Now we just need to add rows where necessary and apply the right values
'Loop through the row numbers in our collection, which are conveniently in REVERSE order (as adding rows will change the row numbers in the range, making forward looping very difficult)
For Each varRowNum In colRowNumsForInsert
'First, insert a new row, shifting everything below it down
.Range("A" & varRowNum).Offset(1).EntireRow.Insert Shift:=xlDown
'Write the date (which are the same)
.Cells(varRowNum + 1, lngDateCol) = .Cells(varRowNum, lngDateCol)
'Write the new location (which is the new location from the row above)
.Cells(varRowNum + 1, lngLocationCountryCol) = .Cells(varRowNum, lngDestinationCountryCol)
.Cells(varRowNum, lngNotesCol) = ""
Next varRowNum
End With
'Let the user know the script is done
MsgBox "Finished!"
End Sub
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function