Question

我将每天将数据添加到我的工作簿中，我通常会使用一组公式来计算失败率和成功率。我已经有了编译数据的代码，但我现在缺少的是如何复制下一个空单元格的公式集，以便它可以帮助我计算速率。我的公式集从“P22”添加到“AB22”，我需要将这些公式复制到下一个空行。这是我现在拥有的宏，如果有足够的好，请检查并查看是否有改进的地方，因为我还是vba的新手。非常感谢你。

Sub trial()

Dim wb As Workbook, wb2 As Workbook, wb3 As Workbook
Dim ws As Worksheet

Dim fn As String

Set wb = ActiveWorkbook
Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
Dim Ret

    Ret = Application.GetOpenFilename("Lkl Files (*.lkl), *.lkl")

    If Ret <> False Then
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Ret, Destination:=Range("$A$1"))
        .Name = "SPC_PLTB_450B_12092107_25°C_CW"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = ","
        .TextFileThousandsSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

        End With
    End If


    Sheets(2).Activate

    'this is for the date (loop)

    Dim FirstCell As String
        Dim i As Integer
            FirstCell = "C19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop
            ActiveCell = Format(Date, "mm/dd/yyyy")

    ws.Activate
    ws.AutoFilterMode = False
    ws.Range("$A$9:$P$417").AutoFilter Field:=5, Criteria1:= _
        "1"
    Range("F31:F401").Select
    Selection.Copy



    Sheets(2).Activate


    'this is for the raw data

            FirstCell = "D19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop


    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

   Sheets(3).Activate
    FirstCell = "C19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop
            ActiveCell = Format(Date, "mm/dd/yyyy")

    ws.Activate

    Range("D31:D401").Select
    Application.CutCopyMode = False
    Selection.Copy


    Sheets(3).Activate
            FirstCell = "D19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop


    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

        Sheets(4).Activate
    FirstCell = "C19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop
            ActiveCell = Format(Date, "mm/dd/yyyy")

    ws.Activate

    Range("G31:G401").Select
    Application.CutCopyMode = False
    Selection.Copy



    Sheets(4).Activate
    FirstCell = "D19"
            Range(FirstCell).Select
            Do Until ActiveCell.Value = ""
            If ActiveCell.Value = "" Then
            Exit Do
            Else
            ActiveCell.Offset(1, 0).Select
            End If
            Loop


    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True


End Sub

我的工作表示例

Answer 1

不要动摇你学习VBA，但我认为在这种情况下，没有它可以逃脱。

您可以对＆＃34; P22＆＃34;中的公式进行一些小改动。到＆＃34; AB22＆＃34;如果＆＃34; D到N＆＃34;

中没有数据，它们就会保持空白

使用您的示例，复制单元格P22并粘贴到单元格P23中。接下来，放一个＆＃34; if＆＃34;公式周围的陈述，如：

=IF ( D23 = "" , "" , {your existing formula here} )

...和＆＃34;填充＆＃34;那个公式向右，向下几十行。细胞＆＃34; P到AB＆＃34;在您输入工作表左侧的数据之前，它将为空白。解释起来很难，但如果这没有意义，我可以寄给你一份样本工作表。我

Answer 2

在不了解更多有关现有Excel文件的情况下提供理想的解决方案很棘手，但我根据您发布的内容做了一些假设，并将Excel文件与几个可能的解决方案放在一起。

由于我们无法在此处将文件附加到帖子，因此我将其上传到免费文件主机FileTown;您可以下载[宏禁用] XLSX file here。

按照表单' Example1 '上的步骤操作，了解我将为您稍后添加的数据创建公式的含义示例，以及如何通过将数据转换为Excel'表格来自动更新图表，以及如何创建与源数据文件的数据连接，这样您无需在任何时候重新导入数据更改，所有没有宏。

不要阻止你学习VBA＆amp;宏，但Excel有一些非常强大的内置数据管理功能，在这种情况下，可能是一种比自定义更好的方法。

另一方面，我首先通过在执行简单的重复性任务时记录宏来开始学习VBA（在90年代使用Excel v.5），然后通过“更改此行或删除该行”来尝试生成的VBA，看看发生了什么;在录制的宏中自动生成的Excel的大约一半代码可能是无关紧要的。（只需在弄乱它们之前制作文件的备份副本，然后检查MSDN/VBA或Google是否有任何您感兴趣的内容，并且没有什么可失去的......我是Excel的忠实粉丝，因为VBA及其“内置功能，其功能无穷无尽！”

如何从选定范围复制公式并使用宏将其复制到下一个空行

2 个答案: