Переместить строку на разные листы, основываясь на значении в 1 ячейке, но не может каждый раз получать новую строку - PullRequest
0 голосов
/ 13 января 2019

Я что-то пробовал, глядя на другой пример кода и тому подобное.

Но у меня есть некоторые проблемы.

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

Также, когда он перемещает его, он сначала перемещает его в строку 2, затем в строку 4. Так что перепрыгните через строку 3, но затем после этого просто снова перейдите в строку 4 и перезапишите то, что находится в строке 4. Я думаю, что мне нужны какие-то переменные здесь для каждого листа, но я не силен в VBA, поэтому не уверен, как это сделать.

Вот код, который у меня есть.

Sub CommandButton1_Click()
Dim TargetCounters(3) As Integer
Dim TargetNames(3) As String
TargetNames(0) = "Co"
TargetNames(1) = "Od"
TargetNames(2) = "Th"
TargetNames(3) = "Ca"

Dim i As Integer
Dim shSource As Worksheet

Dim shTargets(3) As Worksheet

Set shSource = ThisWorkbook.Sheets("Data input")

For i = 0 To 3
Set shTargets(i) = ThisWorkbook.Sheets(TargetNames(i))
If shTargets(i).Cells(2, 1).Value = "" Then
    TargetCounters(i) = 2
Else 
    TargetCounters(i) = shTargets(i).Cells(2, 1).CurrentRegion.Rows.Count + 2
End If
Next i

i = 2
Dim MatchIndex As Integer

Do Until shSource.Cells(i, 1).Value = ""

        Select Case shSource.Cells(i, 1).Value
        Case "Co":
            MatchIndex = 0
        Case "Od":
            MatchIndex = 1
        Case "Th":
            MatchIndex = 2
        Case "Ca":
            MatchIndex = 3
        Case Else
            MatchIndex = -1
        End Select
        If (MatchIndex = -1) Then
            i = i + 1
        Else
            shSource.Rows(i).Copy
            shTargets(MatchIndex).Cells(TargetCounters(MatchIndex), 1).PasteSpecial Paste:=xlPasteValues
            shSource.Rows(i).Delete
            TargetCounters(MatchIndex) = TargetCounters(MatchIndex) + 1
        End If
    Loop
End Sub

Вот ссылка на Excel, который я сделал. Прямо сейчас я только сделал это, чтобы перейти на 4 листа, но при работе я смогу добавить остальные. https://www.dropbox.com/s/vvjt8z82xiuw9y1/Movedata.xlsm?dl=0

Короче мои проблемы это

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

РЕДАКТИРОВАТЬ:

Узнали об удаляемой части сейчас. Нашел там функцию ClearContents вместо Delete.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...