大神们好。
如何用VB代码判断表内单元格是否有值（单元格内使用查找函数自动查找并填充值），如果查找不到，单元格为空则隐藏或删除行，最后一行合计上移，如果查找到值则显示行或增加行，最后一行合计下移。

[此贴子已经被作者于2023-4-25 07:45编辑过]

操作EXCEL呀，是不是VBA编程呢。

判断单元格为空的语句是=""，添加和插入行的方式可以实现，最简单的方式是全新建表。

我下面用VBA编写了代码来实现这个功能的程序代码：

Option Explicit

Sub 生成值班表()
    Dim arr, i&, j&, k&, k1&
    arr = Sheets("sheet2").UsedRange
    Sheets("sheet1").Activate
    Cells.Delete
    Range("a1") = "签到表"
    Range("a1:c1").Merge
    Range("a2:c2") = Array("日期", "姓名", "备注")
    k1 = 3
    For i = 2 To UBound(arr)
        k = k1
        Cells(k, 1) = arr(i, 1)
        For j = 2 To UBound(arr, 2)
            If arr(i, j) <> "" Then
                Cells(k, 2) = arr(i, j)
                k = k + 1
            End If
        Next j
        If k - 1 > k1 Then Range(Cells(k1, 1), Cells(k - 1, 1)).Merge
        k1 = k
    Next i
    Cells(k, 1) = "合计"
    ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
End Sub

我的测试数据：


执行效果：

下面是一个示例代码，可以根据需要进行修改和适当的调整：

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Range("A2:D10") '修改为要判断的范围

If Not Intersect(Target, rng) Is Nothing Then '判断是否在范围内发生变化
    Application.EnableEvents = False '关闭事件处理，避免死循环
    
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row '获取最后一行行号
    
    Dim i As Long
    Dim rowVisible As Boolean '记录行是否可见
    Dim foundValue As String '记录查找到的值
    With Range("A2:D" & lastRow)
        For i = lastRow To 2 Step -1 '从下往上循环，避免删除行时行号变化问题
            rowVisible = False '默认行不可见
            
            If Len(.Cells(i, 1).Value) = 0 Then '判断第一列单元格是否有值
                .Cells(i, 1).EntireRow.Hidden = True '隐藏行
            Else
                foundValue = "" '重置查找到的值
                
                '在需要查找的范围内查找值
                Dim searchRange As Range
                Set searchRange = Range("E2:E10") '修改为要查找的范围
                Set rngFind = searchRange.Find(What:=.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not rngFind Is Nothing Then '查找到值
                    foundValue = rngFind.Value '记录查找到的值
                    rowVisible = True '显示行
                End If
                
                If rowVisible Then '行可见
                    .Cells(i, 2).Value = foundValue '自动填充第二列单元格的值
                Else '行不可见
                    .Rows(i).Delete Shift:=xlUp '删除行，合计下移
                    lastRow = lastRow - 1 '调整最后一行行号
                End If
            End If
        Next i
        
        .Rows(lastRow + 1).Formula = "=SUM(A2:A" & lastRow & ")" '最后一行合计上移
    End With
    
    Application.EnableEvents = True '打开事件处理
End If
End Sub

谢谢我试试

谢谢我试试