Данные не копируются как надо - PullRequest
0 голосов
/ 27 апреля 2018

Я в растерянности. Я работал над этой действительно маленькой программой, которая должна была занять 5 минут в течение полутора часов. Он добавляет всю информацию правильно, за исключением того, что он не находит две ячейки в соответствующих строках. Iv поставил хеш-теги тем, что я считаю проблемой.

Dim q As String
Dim w As String
Dim p As Integer
Dim o As Integer
Dim r As String
Dim lRow As Integer

lRow = ThisWorkbook.Sheets("Data2").Cells(Rows.Count, 1).End(xlUp).Row + 1

q = TextBox4.Text
w = TextBox5.Text
r = TextBox4.Text + TextBox5.Text

ThisWorkbook.Sheets("Data2").Cells(lRow, 1) = r

For p = 1 To 1000

   If ((ThisWorkbook.Sheets("Data").Cells(2, p) = q Or _
        ThisWorkbook.Sheets("Data").Cells(2, p) = w) And _
        (ThisWorkbook.Sheets("Data").Cells(1, p) = q Or _
         ThisWorkbook.Sheets("Data").Cells(1, p) = w)) And _
         (Not ThisWorkbook.Sheets("Data").Cells(1, p) = _
          ThisWorkbook.Sheets("Data").Cells(1, p)) Then '#########################################
   ' If (StrComp(ThisWorkbook.Sheets("Data").Cells(p, 2), q, vbTextCompare) = 0) Or (StrComp(ThisWorkbook.Sheets("Data").Cells(p, 2), q, vbTextCompare) = 0) And (StrComp(ThisWorkbook.Sheets("Data").Cells(p, 1), w, vbTextCompare) = 0) Or (StrComp(ThisWorkbook.Sheets("Data").Cells(p, 1), q, vbTextCompare) = 0) Then
        For o = 3 To 1000
            If (Not ThisWorkbook.Sheets("Data").Cells(o, p) = "") Then
                 ThisWorkbook.Sheets("Data2").Cells(lRow, o) = _
                          ThisWorkbook.Sheets("Data").Cells(o, p)
            End If
        Next o

    End If


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