Блог

Главная - Вопросы по программированию - Копировать всю строку Excel с одного листа на другой на основе критериев, специфичных для 4 ячеек

Копировать всю строку Excel с одного листа на другой на основе критериев, специфичных для 4 ячеек

#excel #vba

#excel #vba

Вопрос:

В основном то, что я пытаюсь сделать на листе рабочей книги RAWinsightly , заключается в следующем:

  • Если строка пуста: не копируйте.
  • Если столбец J содержит слово «Коммерческий»: скопируйте строку, если столбец K также не содержит слов «потерянный» или «заброшенный».

Код, который я смог выяснить, отлично работает для первых двух, но я ни за что на свете не могу понять, как добавить столбец K stuff.

 Sub copyJobs()
  Dim r1
  Dim r2
  Dim r3

  r1 = 1
  r2 = 1
  r3 = 1

  While Sheets("RAWInsightly").Range("A" amp; LTrim(Str(r1))) <> ""
    If Sheets("RAWInsightly").Range("J" amp; LTrim(Str(r1))) = "Commercial" Then
      Sheets("RAWInsightly").Range(LTrim(Str(r1)) amp; ":" amp; LTrim(Str(r1))).Copy
      Sheets("RAWCommercial").Range("A" amp; LTrim(Str(r2))).PasteSpecial xlPasteAll
      r2 = r2   1
    End If
    If Sheets("RAWInsightly").Range("J" amp; LTrim(Str(r1))) = "failed" Then
      Sheets("RAWInsightly").Range(LTrim(Str(r1)) amp; ":" amp; LTrim(Str(r1))).Copy
      Sheets("RAWhousing").Range("A" amp; LTrim(Str(r3))).PasteSpecial xlPasteAll
      r3 = r3   1
    End If
    r1 = r1   1
  Wend
End Sub

Комментарии:

1. Найдите в справке Excel VBA «и». Третий хит (во всяком случае, в моей копии) — это страница оператора And, которая должна рассказать вам все, что вам нужно знать.

2. Кроме того, вы можете использовать, например, .Cells(r1,1) (номера строк и столбцов) вместо .Range("A" amp; LTrim(Str(r1))) , и .Rows(r1) вместо .Range(LTrim(Str(r1)) amp; ":" amp; LTrim(Str(r1))) , что сделает ваш код более быстрым и читабельным.

Ответ №1:

 Sub copyJobs()
  Dim r1
  Dim r2
  Dim r3
  Dim shtSrc as Worksheet
  Dim tmp, tmp2

  r1 = 1
  r2 = 1
  r3 = 1

  Set shtSrc = Sheets("RAWInsightly")

  While len(shtSrc.Cells(r1, "A").Value) > 0

      'performing case-insensitive checks...
      tmp = LCase(shtSrc.Cells(r1, "J").Value)
      tmp2 = LCase(shtSrc.Cells(r1, "K").Value)

      If tmp = "commercial" And tmp2 <> "lost" And tmp2 <> "abandoned" Then
          shtSrc.Rows(r1).Copy Sheets("RAWCommercial").Cells(r2, "A")
          r2 = r2   1
      End If

      If tmp = "failed" Then
          shtSrc.Rows(r1).Copy Sheets("RAWhousing").Cells(r3, "A")
          r3 = r3   1
      End If

      r1 = r1   1

  Wend

End Sub

Комментарии:

1. Блестяще! Спасибо!

2. Я также получил этот ответ: В то время как листы («RAWInsightly»). Диапазон («A» amp; LTrim(Str(r1))) <> «» Если листы («RAWInsightly»). Диапазон («J» amp; LTrim(Str(r1))) = «Коммерческий» И _ листов («RAWInsightly»). Диапазон («K» amp; LTrim(Str(r1))) <> «Lost» И _ Листов («RAWInsightly»). Диапазон («K» amp; LTrim(Str(r1))) <> «Заброшенный», затем листы («RAWInsightly»). Диапазон (LTrim(Str(r1)) amp; «:» amp; LTrim(Str(r1))). Копирование листов («RAWCommercial»). Диапазон(«A» amp; LTrim(Str(r2))).Вставить специальный xlPasteAll r2 = r2 1 конец, если