Мой код будет совпадать только со значением и заменять соседние значения, когда я использую два поля ввода - PullRequest
0 голосов
/ 17 февраля 2019

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

Я хочу, чтобы это было сделано только с одним InputBox.Мне удалось собрать воедино следующий код, который работает для меня, но он требует, чтобы я нашел соответствующее значение самостоятельно на втором листе.Я попытался манипулировать им, чтобы автоматически найти второе значение, однако у меня возникли проблемы с этим.

Вот примеры значений для

ReplaceRng (sheet1) : https://imgur.com/d59NDg5

Name = RandomName
Value1 = 27
Value2 = 29
Value3 = 31

InputRng (sheet2) : https://imgur.com/iiSTtrw

ReplaceRng Name = RandomName
ReplaceRng Value1 = 25
ReplaceRng Value2 = 22
ReplaceRng Value3 = 25

Так что, если я использую этот код,Я могу найти и заменить значения, но для этого требуются два поля ввода:

Sub ReplaceRange 
Dim rng As Range  
Dim InputRng As Range, ReplaceRng As Range 
xTitleId = "ReplaceRange"   

'В этой части я вставляю данные

Set InputRng = Application.Selection 
Set InputRng = Application.InputBox("Original Range ", xTitleId,    
InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False

' Это гдеInputRng назначается имя переменной для каждого значения в диапазоне

For Each rowInputRng In InputRng.Rows
Dim Name As String, Value1 As Integer, Value2 As Integer, Value3 As Integer
Name = InputRng.Cells(1).Value
Value1 = InputRng.Cells(2).Value
Value2 = InputRng.Cells(3).Value
Value3 = InputRng.Cells(4).Value

'Если первая ячейка в диапазоне Replace такая же, как во входном диапазоне, то соседние ячейки заменяются

For Each Row In ReplaceRngRng.Rows
If Row.Cells(1).Value = Name Then
Row.Cells(2).Value = Value1
Row.Cells(3).Value = Value2
Row.Cells(4).Value = Value3

End If
Next Row  
Next rowInputRng  
End Sub

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

'Поиск значения

xTitleId = "RangeValueReplace"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId,       
InputRng.Address, Type:=8)
Set ReplaceRng =     
Application.WorksheetFunction.VLookup("InputRng.Cells(1).Value", 
"Sheet1!A1:A1000", 1, 0))

' Замена соседних ячеек

For Each Row In ReplaceRng.Rows
If ReplaceRng.Cell(1).Value = Name Then
ReplaceRng.Cells(1).Offset(, 1).Value = Value1
ReplaceRng.Cells(1).Offset(, 2).Value = Value2
ReplaceRng.Cells(1).Offset(, 3).Value = Value3
End If
Next Row

Для большинства ошибок я получаю "синтаксическую ошибку" или ошибку времени выполнения "1004" Не удается получить свойство Vlookup класса WorksheetFunction

Ответы [ 2 ]

0 голосов
/ 21 февраля 2019

Так что я решил найти решение своей проблемы.Обратите внимание, что то, что ActiveCell вы используете, важно.

Sub Findreplace()

Dim InputRng As Range, ReplaceRng As Range

            xTitleId = "Findandreplace"

            Set InputRng = Application.Selection

            Set InputRng = Application.InputBox("Original Range ", xTitleId, 
            InputRng.Address, Type:=8)


            vFind = ActiveCell


            On Error Resume Next

                    With Sheet1

             Set rFound = .UsedRange.Find(What:=vFind, After:=.Cells(1, 1), 
            LookIn:=xlFormulas, LookAt:= _xlPart, SearchOrder:=xlByRows, 
                                 SearchDirection:=xlNext, MatchCase:=False)

                        If Not rFound Is Nothing Then

                    Application.Goto rFound, True

             End If

             End With


            Set ReplaceRng = rFound

            Application.ScreenUpdating = False


            Dim Name As String, Value1 As Integer, Value2 As Integer, Value3 As 
    Integer

                Name = InputRng.Cells(1).Value

                Value1 = InputRng.Cells(2).Value

                Value2 = InputRng.Cells(3).Value

                Value3 = InputRng.Cells(4).Value

                Value4 = InputRng.Cells(5).Value



            If ReplaceRng.Value = Name Then

                ReplaceRng.Offset(, 1).Value = Value1

                ReplaceRng.Offset(, 2).Value = Value2

                ReplaceRng.Offset(, 3).Value = Value3

                ReplaceRng.Offset(, 4).Value = Value4

            End If


End Sub
0 голосов
/ 17 февраля 2019

При использовании «ReplacingRng.Cells (1)» Как насчет использования этого формата ... Клетки (строка, столбец).Пример ...

For Each Row In ReplaceRng.Rows
    If ReplacingRng.Cell(row,1).Value = Name Then
        ReplacingRng.Cells(row,2).value = ValueWhatever
    End if
Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...