搜索并替换其他工作表
我陷入了代码问题，另一个用户帮助我解决了这个问题，代码要做的就是在工作表中搜索最后的信息，然后替换下一个空白单元格来获取其他工作表中的信息。代码在起作用，我完全没有移动它，然后当我完成proyect时，我尝试了一下，代码没有起作用。 R2不能很好地检测到最后一个空白单元格，相反，当范围中包含信息时，它会补充第一个非空白单元格；当它没有信息时，它会往下5行。
图片1这是人们会填写的格式，示例搜索346
图片2然后应在其中粘贴信息的346格式是这样的（它已经有信息了）
图像3添加信息应该像这样（将信息添加到旧信息下方而不是重写）
Private Sub C1_Click()
Dim Partida As String
Dim Rng As Range, r1 As Range, r2 As Range, UPa As Range
Dim Respuesta As String
If Sheets("Materiales").Range("C4").Value <> "Blanco" Then
'------------------------> Color
Sheets("Color").Unprotect
Partida = Worksheets("Materiales").Range("C3").Value
If Trim(Partida) <> "" Then
With Sheets("Color").Rows("6:6")
Set Rng = .Find(What:=Partida, After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Set r2 = Rng.Offset(4, -1).End(xlDown)
'If r2.Row > 19 Then
' Set r2 = Rng.Offset(4, -1)
'Else
'Set r2 = r2.Offset(1)
'End If
For Each r1 In Worksheets("Materiales").Range("B7:B16")
If Len(r1) > 0 Then
r2.Resize(, 2).Value = r1.Resize(, 2).Value
Set r2 = r2.Offset(1)
End If
Next r1
完整代码：
Private Sub C1_Click()
Dim Partida As String
Dim Rng As Range, r1 As Range, r2 As Range, UPa As Range
Dim Respuesta As String
If Sheets("Materiales").Range("C4").Value <> "Blanco" Then
'------------------------> Color
Sheets("Color").Unprotect
Partida = Worksheets("Materiales").Range("C3").Value
If Trim(Partida) <> "" Then
With Sheets("Color").Rows("6:6")
Set Rng = .Find(What:=Partida, After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Set r2 = Rng.Offset(4, -1).End(xlDown)
'If r2.Row > 19 Then
' Set r2 = Rng.Offset(4, -1)
'Else
'Set r2 = r2.Offset(1)
'End If
For Each r1 In Worksheets("Materiales").Range("B7:B16")
If Len(r1) > 0 Then
r2.Resize(, 2).Value = r1.Resize(, 2).Value
Set r2 = r2.Offset(1)
End If
Next r1
Finalizar = MsgBox("Información Agregada", vbOKOnly)
Sheets("Materiales").Range("C2:C4").Value = ""
Sheets("Materiales").Range("B7:C16").Value = ""
Else
Respuesta = MsgBox("No se encontró, desea agregar la partida: " & Worksheets("Materiales").Range("C3").Value, vbYesNo, "Partida no encontrada")
If Respuesta = vbYes Then
With Sheets("Color").Rows("5:5")
Set UPa = .Find(What:="", Lookat:=xlWhole)
UPaD = UPa.Column
End With
Sheets("Patrón").Range("A1:C39").Copy
With Sheets("Color")
.Cells(5, UPaD).PasteSpecial PASTE:=xlPasteColumnWidths
.Cells(5, UPaD).PasteSpecial PASTE:=xlPasteAll
End With
With Sheets("Color")
Llenado = UPaD + 1
.Cells(5, Llenado).Value = Sheets("Materiales").Range("C2").Value
.Cells(6, Llenado).Value = Sheets("Materiales").Range("C3").Value
.Cells(7, Llenado).Value = Sheets("Materiales").Range("C4").Value
.Cells(10, UPaD).Value = Sheets("Materiales").Range("B7").Value
.Cells(10, Llenado).Value = Sheets("Materiales").Range("C7").Value
.Cells(11, UPaD).Value = Sheets("Materiales").Range("B8").Value
.Cells(11, Llenado).Value = Sheets("Materiales").Range("C8").Value
.Cells(12, UPaD).Value = Sheets("Materiales").Range("B9").Value
.Cells(12, Llenado).Value = Sheets("Materiales").Range("C9").Value
.Cells(13, UPaD).Value = Sheets("Materiales").Range("B10").Value
.Cells(13, Llenado).Value = Sheets("Materiales").Range("C10").Value
.Cells(14, UPaD).Value = Sheets("Materiales").Range("B11").Value
.Cells(14, Llenado).Value = Sheets("Materiales").Range("C11").Value
.Cells(15, UPaD).Value = Sheets("Materiales").Range("B12").Value
.Cells(15, Llenado).Value = Sheets("Materiales").Range("C12").Value
.Cells(16, UPaD).Value = Sheets("Materiales").Range("B13").Value
.Cells(16, Llenado).Value = Sheets("Materiales").Range("C13").Value
.Cells(17, UPaD).Value = Sheets("Materiales").Range("B14").Value
.Cells(17, Llenado).Value = Sheets("Materiales").Range("C14").Value
.Cells(18, UPaD).Value = Sheets("Materiales").Range("B15").Value
.Cells(18, Llenado).Value = Sheets("Materiales").Range("C15").Value
.Cells(19, UPaD).Value = Sheets("Materiales").Range("B16").Value
.Cells(19, Llenado).Value = Sheets("Materiales").Range("C16").Value
End With
Finalizar = MsgBox("Información Agregada", vbOKOnly)
Sheets("Materiales").Range("C2:C4").Value = ""
Sheets("Materiales").Range("B7:C16").Value = ""
End If
If Respuesta = vbNo Then
Sheets("Materiales").Activate
End If
End If
End With
Sheets("Color").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
PartidaN = MsgBox("Agregar partida", vbCritical, "Error")
End If
Else
'--------------------------> Blanco
Sheets("Blanco").Unprotect
Partida = Worksheets("Materiales").Range("C3").Value
If Trim(Partida) <> "" Then
With Sheets("Blanco").Rows("6:6")
Set Rng = .Find(What:=Partida, After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Set r2 = Rng.Offset(4, -1).End(xlDown)
If r2.Row > 19 Then
Set r2 = Rng.Offset(4, -1)
Else
Set r2 = r2.Offset(1)
End If
For Each r1 In Worksheets("Materiales").Range("B7:B16")
If Len(r1) > 0 Then
r2.Resize(, 2).Value = r1.Resize(, 2).Value
Set r2 = r2.Offset(1)
End If
Next r1
Finalizar = MsgBox("Información Agregada", vbOKOnly)
Sheets("Materiales").Range("C2:C4").Value = ""
Sheets("Materiales").Range("B7:C16").Value = ""
Else
Respuesta = MsgBox("No se encontró, desea agregar la partida: " & Worksheets("Materiales").Range("C3").Value, vbYesNo, "Partida no encontrada")
If Respuesta = vbYes Then
With Sheets("Blanco").Rows("5:5")
Set UPa = .Find(What:="", Lookat:=xlWhole)
UPaD = UPa.Column
End With
Sheets("Patrón").Range("A1:C39").Copy
With Sheets("Blanco")
.Cells(5, UPaD).PasteSpecial PASTE:=xlPasteColumnWidths
.Cells(5, UPaD).PasteSpecial PASTE:=xlPasteAll
End With
With Sheets("Blanco")
Llenado = UPaD + 1
.Cells(5, Llenado).Value = Sheets("Materiales").Range("C2").Value
.Cells(6, Llenado).Value = Sheets("Materiales").Range("C3").Value
.Cells(7, Llenado).Value = Sheets("Materiales").Range("C4").Value
.Cells(10, UPaD).Value = Sheets("Materiales").Range("B7").Value
.Cells(10, Llenado).Value = Sheets("Materiales").Range("C7").Value
.Cells(11, UPaD).Value = Sheets("Materiales").Range("B8").Value
.Cells(11, Llenado).Value = Sheets("Materiales").Range("C8").Value
.Cells(12, UPaD).Value = Sheets("Materiales").Range("B9").Value
.Cells(12, Llenado).Value = Sheets("Materiales").Range("C9").Value
.Cells(13, UPaD).Value = Sheets("Materiales").Range("B10").Value
.Cells(13, Llenado).Value = Sheets("Materiales").Range("C10").Value
.Cells(14, UPaD).Value = Sheets("Materiales").Range("B11").Value
.Cells(14, Llenado).Value = Sheets("Materiales").Range("C11").Value
.Cells(15, UPaD).Value = Sheets("Materiales").Range("B12").Value
.Cells(15, Llenado).Value = Sheets("Materiales").Range("C12").Value
.Cells(16, UPaD).Value = Sheets("Materiales").Range("B13").Value
.Cells(16, Llenado).Value = Sheets("Materiales").Range("C13").Value
.Cells(17, UPaD).Value = Sheets("Materiales").Range("B14").Value
.Cells(17, Llenado).Value = Sheets("Materiales").Range("C14").Value
.Cells(18, UPaD).Value = Sheets("Materiales").Range("B15").Value
.Cells(18, Llenado).Value = Sheets("Materiales").Range("C15").Value
.Cells(19, UPaD).Value = Sheets("Materiales").Range("B16").Value
.Cells(19, Llenado).Value = Sheets("Materiales").Range("C16").Value
End With
Finalizar = MsgBox("Información Agregada", vbOKOnly)
Sheets("Materiales").Range("C2:C4").Value = ""
Sheets("Materiales").Range("B7:C16").Value = ""
End If
If Respuesta = vbNo Then
Sheets("Materiales").Activate
End If
End If
End With
Sheets("Blanco").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
PartidaN = MsgBox("Agregar partida", vbCritical, "Error")
End If
End If
End Sub
没有错误提示
2 个答案:
答案 0 :(得分：0)
移动注释来回答问题，因为查看注释中的代码非常棒。
Set Rng = .Find(What:=Partida, After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
Set MatHead = Rng.Offset(3,-1)
If MatHead.end(xldown).font.bold = true then
lr = MatHead.Offset(1).Row + 1
Else
lr = MatHead.End(xlDown).Row + 1
End if
Cells(lr,1).Value = MATERIALES 'fix
Cells(lr,2).Value = KILOS 'fix
这里最大的问题是，如果您将值填充到第10到19行中，则.end(xldown)总是以第20行结尾，这是加粗的值“ Total”，这意味着您将开始覆盖第10行的值（基于图像的行数）。
如果可能，您可能要考虑避免这种情况。
答案 1 :(得分：0)
问题似乎是一个简单的行，@ Cyrill让我意识到，由于代码无法检测到标头，仅通过将起始范围从4交换为3，它便开始检测标头和下面的信息。谢谢大家医治我：）
Private Sub C1_Click()
Dim Partida As String
Dim Rng As Range, r1 As Range, r2 As Range, UPa As Range
Dim Respuesta As String
If Sheets("Materiales").Range("C4").Value <> "Blanco" Then
'------------------------> Color
Sheets("Color").Unprotect
Partida = Worksheets("Materiales").Range("C3").Value
If Trim(Partida) <> "" Then
With Sheets("Color").Rows("6:6")
Set Rng = .Find(What:=Partida, After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Set r2 = Rng.Offset(3, -1).End(xlDown)
If r2.Row > 19 Then
Set r2 = Rng.Offset(4, -1)
Else
Set r2 = r2.Offset(1)
End If
For Each r1 In Worksheets("Materiales").Range("B7:B16")
If Len(r1) > 0 Then
r2.Resize(, 2).Value = r1.Resize(, 2).Value
Set r2 = r2.Offset(1)
End If
Next r1
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？