我會加入數據轉換成我的日常工作簿,我通常會使用一套公式來計算的故障率和成功對我來說。我已經有代碼編譯的數據,但我現在缺乏的是如何設定的公式複製下一個空單元格,以便它可以幫我算算率。我的公式集從「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
例
非常感謝你@ashleedawg!沒有期望的東西如此詳細,但非常感謝哈哈..雖然我正在考慮用宏來做,但我認爲手動將它拖拽到100行應該沒問題,我猜... – Fong
不客氣。別擔心,您將有*很多*更多的機會讓MS Office變得超級複雜! – ashleedawg