代码不知道哪里出问题了，请老师帮忙看看。

dbg111222

从收入表中获取数据，验收记录表中1-8行不变，第9行开始根据收入表内容自动添加行数，最下面保留6行内容不变。请老师帮忙看看，代码运行后内容没有从收入表中获取，最后6行内容也不见了。模块3。

Qs18

UsedRange.Offset(8).ClearContents被这句代码删除了

dbg111222

Qs18 发表于 2024-5-21 10:48
UsedRange.Offset(8).ClearContents被这句代码删除了

能按照我的要求给修改一下吗，谢谢！

Qs18

dbg111222 发表于 2024-5-21 11:11
能按照我的要求给修改一下吗，谢谢！

不知道您要查询数据的条件，还是全部的数据

半百

预设100行空白行，写入数据后隐藏多余的行。

dbg111222

半百 发表于 2024-5-21 12:13
预设100行空白行，写入数据后隐藏多余的行。

非常感谢，但是我的表头第4第5行数据怎么带入呢？

Qs18

半百 发表于 2024-5-21 12:13
预设100行空白行，写入数据后隐藏多余的行。

您合并的单元格太多，我写了增加行数的过程这个是根据您的需要自己可以输入需要的行数，另外就是删除的空白行数两个过程。可以根据您的业务逻辑call一下就可以。您自己的业务逻辑我没有动。

Qs18

Sub 插入空白行()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Sheet8
  For i = 1 To InputBox("请输入您需要增加的行数！")
    .Rows("9:9").Copy
    .Range("A10").Insert Shift:=xlDown
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = False

End Sub
Sub 删除空白行()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
i = Sheet8.Range("a:a").Find("*" & "保管员:" & "*").Row - 6
For j = i To 9 Step -1
    If Len(Sheet8.Cells(j, "d").Value) < 1 Then
        Rows(j & ":" & j).Delete Shift:=xlUp
    End If
Next
Application.DisplayAlerts = ture
Application.ScreenUpdating = True
End Sub

dbg111222

Qs18 发表于 2024-5-21 12:13
不知道您要查询数据的条件，还是全部的数据

字段对应收入表字段的内容

3190496160

Sub 验收记录()
Dim ar As Variant
Dim br()
Dim r As Long
Dim cellDate As Date
Dim i As Long
With Sheets("收入")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    If r < 2 Then MsgBox "表为空！": End
    ar = .Range("a1:t" & r)
End With
With Sheets("验收记录")
    cellDate = .Range("K3").Value
    If cellDate = 0 Then MsgBox "请输入日期！": End
    ReDim br(1 To UBound(ar), 1 To 12)
    For i = 2 To UBound(ar)
        If ar(i, 20) = cellDate Then
            n = n + 1
            br(n, 1) = n
            br(n, 2) = Split(ar(i, 4), " ", 2)(0) ' 第一个空格前的内容
            br(n, 4) = Split(ar(i, 4), " ", 2)(1) ' 第一个空格后的内容
            br(n, 5) = ar(i, 5)
            br(n, 8) = ar(i, 11)
        End If
    Next i
    If n = "" Then MsgBox "收入表中没有" & cellDate & "的数据！": End
    rs = .Cells(Rows.Count, 1).End(xlUp).Row - 6
    If rs >= 9 Then
        .Rows("9:" & rs).Delete
    End If
     .Rows("9:" & 9 + n - 1).Insert Shift:=xlDown
     For i = 9 To 9 + n - 1
         .Cells(i, 2).Resize(1, 2).Select
         With Selection
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
         End With
         Selection.Merge
         .Cells(i, 8).Resize(1, 2).Select
         With Selection
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
         End With
         Selection.Merge
    Next i
    .[a9].Resize(n, UBound(br, 2)) = br
    .[a8].Resize(n + 1, UBound(br, 2)).Borders.LineStyle = 1
    With .Rows("9:" & n + 9 - 1)
        .Font.Name = "宋体"
        .Font.Size = 11
        .RowHeight = 35
        .WrapText = True
    End With
    '.Cells.EntireRow.AutoFit '自动行高'
End With
MsgBox "ok!"
End Sub