Question

对于我的用户表单，我从该网站https://www.contextures.com/exceldataentryupdateform.html中找到了一个非常有用的代码其中包括不同的功能，例如检索现有数据条目。经过一些小的修改，代码可以完美运行-直到我使用合并单元格以使用户表单更“紧凑”为止。

原始代码（上下文）：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim rngDE As Range

Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Dim lCellsDE As Long
Dim lColHist As Long

Set rngA = ActiveCell
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
Set rngDE = inputWks.Range("OrderEntry")
lCellsDE = rngDE.Cells.Count
lColHist = 3 'order data to copy starts in this column on data sheet

  Application.EnableEvents = False

Select Case Target.Address
  Case Me.Range("OrderSel").Address
    Me.Range("CurrRec").Value = Me.Range("SelRec").Value
  Case Me.Range("OrderID").Address
    If Range("CheckID") = True Then
      Me.Range("OrderSel").Value = Me.Range("OrderID").Value
      Me.Range("CurrRec").Value = Me.Range("SelRec").Value
    Else
      Me.Range("OrderSel").ClearContents
      Me.Range("CurrRec").Value = 0
    End If
  Case Else
    GoTo exitHandler
End Select


  With historyWks
      lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
      lLastRec = lastRow - 1
  End With

  With historyWks
      lRec = inputWks.Range("CurrRec").Value
      If lRec > 0 And lRec <= lLastRec Then
        lRecRow = lRec + 1
        .Range(.Cells(lRecRow, lColHist), .Cells(lRecRow, lCellsDE)).Copy
        rngDE.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        rngA.Select
    End If
  End With


exitHandler:
Application.EnableEvents = True
Exit Sub

End Sub

我的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim historyWks As Worksheet  '"All Entries" Worksheet
Dim inputWks As Worksheet    '"Userform" Worksheet
Dim rngA As Range
Dim rngDE As Range

Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long

Set inputWks = Worksheets("Userform")
Set historyWks = Worksheets("All Entries")
Set rngA = inputWks.Range("UserSel")

Application.EnableEvents = False

Select Case Target.Address
  Case Me.Range("UserSel").Address
    Me.Range("CurrRec").Value = Me.Range("SelRec").Value
  Case Me.Range("Form_UserID").Address
    If Range("CheckID") = True Then
      Me.Range("UserSel").Value = Me.Range("Form_UserID").Value
      Me.Range("CurrRec").Value = Me.Range("SelRec").Value
    Else
      Me.Range("UserSel").ClearContents
      Me.Range("CurrRec").Value = 0
    End If
  Case Else
    GoTo exitHandler
End Select

  With historyWks
      lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
      lLastRec = lastRow - 2
  End With

   With historyWks
      lRec = inputWks.Range("CurrRec").Value
      If lRec > 0 And lRec <= lLastRec Then
        lRecRow = lRec + 2
     .Range(.Cells(lRecRow, 2), .Cells(lRecRow, 2)).Copy
    inputWks.Range("Form_UserID").PasteSpecial Paste:=xlPasteValues, Transpose:=False
     .Range(.Cells(lRecRow, 3), .Cells(lRecRow, 3)).Copy
    inputWks.Range("Form_LastName").PasteSpecial Paste:=xlPasteValues, Transpose:=False
     .Range(.Cells(lRecRow, 4), .Cells(lRecRow, 4)).Copy
    inputWks.Range("Form_FirstName").PasteSpecial Paste:=xlPasteValues, Transpose:=False
     .Range(.Cells(lRecRow, 5), .Cells(lRecRow, 5)).Copy
    inputWks.Range("Form_Address").PasteSpecial Paste:=xlPasteValues, Transpose:=False
     .Range(.Cells(lRecRow, 6), .Cells(lRecRow, 6)).Copy
    inputWks.Range("Form_Citizenship").PasteSpecial Paste:=xlPasteValues, Transpose:=False
        rngA.Select
    End If
  End With

exitHandler:
Application.EnableEvents = True
Exit Sub

End Sub

现在，它给我错误消息：“为此，所有合并的单元格必须具有相同的大小。”

我也尝试过...

     .Range(.Cells(lRecRow, 2), .Cells(lRecRow, 2)).Value = inputWks.Range("Form_UserID").Value
     .Range(.Cells(lRecRow, 3), .Cells(lRecRow, 3)).Value = inputWks.Range("Form_LastName").Value
     .Range(.Cells(lRecRow, 4), .Cells(lRecRow, 4)).Value = inputWks.Range("Form_FirstName").Value
     .Range(.Cells(lRecRow, 5), .Cells(lRecRow, 5)).Value = inputWks.Range("Form_Address").Value
     .Range(.Cells(lRecRow, 6), .Cells(lRecRow, 6)).Value = inputWks.Range("Form_Citizenship").Value

...也不起作用。

Answer 1

合并的单元格是邪恶的！尝试通过菜单“格式单元格->对齐方式”

中的“跨选择中心” 文本对齐方式来避免出现这种情况

在一行中选择一系列单元格（就像合并单元格一样）。
右键单击>格式化单元格（ Ctrl + 1 是键盘快捷键）
点击“对齐方式”标签
单击“水平”下拉箭头，然后选择“跨选区居中”
单击“确定”。

请参阅：Stop merging cells!

VBA-复制到合并的单元格不起作用

1 个答案: