VBA Excel: макрос, который ищет в строке определенное значение переменной из определенной ячейки, а затем копирует и вставляет значение в этот столбец - PullRequest
Новая
       11

VBA Excel: макрос, который ищет в строке определенное значение переменной из определенной ячейки, а затем копирует и вставляет значение в этот столбец

0 голосов
/ 05 декабря 2018

В прошлом я делал несколько VBA, но просто не могу найти решение для этого.

Я ищу макрос, который ищет ячейки от C4 до Z4 (одна бесконечная длинная строка, начинающаяся с C4) для поисказначение (число) из ячейки B4, которое меняется еженедельно.Если совпадение найдено, скопируйте и вставьте значения ячеек от B5 до B100 (один бесконечный длинный столбец, начиная с B5) в правильный столбец с C по Z (от C5 и т. Д., Вниз).

С правильным столбцом я имею в видустолбец, в котором макрос находит совпадение между B4 и C4 по Z4.С4 Z4 не является идентичным

1006 * Я искал долго и упорно, а ближайшим я мог бы найти это:. Макро, которая ищет значение в ячейке и затем вставить диапазон в колонке, чтоклетка.EXCEL 2007

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

MsgBox "Столбец даты" для & CStr ([B2] .Value) & "Not Found"

Таким образом, он не находит совпаденийдля меня даже я запускаю его с одинаковыми датами в соответствующих ячейках.(Я, конечно, изменил этот макрос на ячейки)

Этот форум - моя последняя попытка:)

У меня есть следующий код, который не работает: 

Private Sub CommandButton2_Click()

Dim ws As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim cl As Range
Dim dat As Variant

Set ws = ActiveSheet

' Get the Source range
Set rSrc = ws.Range([B5], ws.Columns(2).Cells(ws.Rows.Count, 1).End(xlUp))
dat = rSrc

' Find the Destination column and copy data
Set rDst = ws.Range([D4], ws.Rows(1).Cells(1, ws.Columns.Count).End(xlToLeft))
Set cl = rDst.Find(What:=[B4], _
  After:=rDst.Cells(1, 1), _
  LookIn:=xlValues, _
  LookAt:=xlWhole, _
  SearchOrder:=xlByRows, _
  SearchDirection:=xlNext)
If cl Is Nothing Then
    MsgBox "Column for " & CStr([B4].Value) & " Not Found"
Else
    Set rDst = cl.Offset(1, 0).Resize(UBound(dat, 1), 1)
    rDst = dat
End If

End Sub

Спасибо.

С уважением

1 Ответ

0 голосов
/ 05 декабря 2018 
Sub FindandCopy
Dim what as range
dim where as range
dim found as range
set what = range("b4")  'what we're looking for
set where = range("c4")  'start of search range
do
if where = what then 
    set found = where  'that's where we found it
else
 set where = where.offset(0,1) 'otherwise keep looking
end if
loop until where = ""   'stop if blank
if found = "" then  'we fell off the end
      msgbox what & " not found "
else
      range(range("b5"),range("b5").end(xldown)).copy 
      found.offset(1,0).pastespecial xlpastevalues
end if
end sub
...