我对代码的行为感到困惑，所以我有一个问题。如果我运行以下代码，有时，“原始”工作表中的输入会被删除完成。如果我重新启动xls并使用原始工作表中的相同（！）输入来运行代码，则它运行得很好。你有一个主意吗，我完全一无所知是什么原因？而我该如何解决呢？
非常感谢， 埃卡
Sub dataset_transformation()
Dim irow As Long
Dim icol As Integer
Dim lastRw As Long
On Error Resume Next
'Deleting empty rows
'Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Deleting the temp sheet on the workbook (in case it exists)
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = "interim" Then
Sheet.Delete
End If
Next Sheet
'Adding the brand new working sheets
Sheets.Add After:=Sheets("raw")
ActiveSheet.Name = "interim"
Sheets("raw").Select
'Loop through rows - Bottom to top
For irow = Cells.SpecialCells(xlLastCell).Row To 2 Step -1
'Loop Through Columns right to left
For icol = Cells.SpecialCells(xlLastCell).Column To 1 Step -1
'If Cell is Bold - Do Nothing
If Cells(irow, icol).Font.FontStyle = "Bold" Then
'If Cell is Normal and Not empty - Do nothing
ElseIf Cells(irow, icol).Font.FontStyle = "Regular" And Not IsEmpty(Cells(irow, icol)) Then
'Otherwise - Delete row
Else
Cells(irow, icol).EntireRow.Delete
'Exit Loop
Exit For
End If
Next icol
Next irow
'Removing the extra space in the amount column
'Range("B1:D" & Cells(Rows.Count, 1).End(xlUp).Row).Replace What:=".", Replacement:=",", SearchOrder:=xlByColumns
Range("B1:D" & Cells(Rows.Count, 1).End(xlUp).Row).Replace What:=" ", Replacement:="", SearchOrder:=xlByColumns
Rows("1:2").Select
Range("A2").Activate
Selection.Delete Shift:=xlUp
'Converting count & sum columns to numbers
Columns("B:B").Select
'Range("B226").Activate
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("D:D").Select
'Range("D226").Activate
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Identifying the intend level
'Dim CurCell As Range
'Set CurCell = ActiveCell
Cells(2, 1).Select
Do While Trim(ActiveCell.Value) <> ""
ActiveCell.Offset(0, 4).Value = ActiveCell.IndentLevel
ActiveCell.Offset(1, 0).Select
Loop
'Copying the Ylan-Yde data to a new sheet
Columns("A:A").Select
Selection.Find("??????? ATLAS ????-???", LookIn:=xlValues).Select
Range(ActiveCell.Address & ":" & Cells(Cells(Rows.Count, "A").End(xlUp).Row, ActiveCell.Column + 4).Address).Select
Selection.Copy
'Pasting the Ylan-Yde data to the new sheet
Sheets("interim").Select
Range("A1").Select
ActiveSheet.Paste
'Creating the column which says whether it is a main shop or Ylan-Yde
'Main shop
Sheets("raw").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("B3").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)
'Ylan-Yde
Sheets("interim").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)
'Deleting the Ylan-Yde data from the Atlas data
Sheets("raw").Select
Columns("B:B").Select
Selection.Find("??????? ATLAS ????-???", LookIn:=xlValues).Select
Rows(ActiveCell.Row & ":" & Rows.Count).Delete
'Deleting the total sum row
Sheets("interim").Select
ActiveSheet.Cells(Rows.Count, "A").End(xlUp).EntireRow.Delete
'Calculating the % contribution to total - main shop sheet
Sheets("raw").Select
Range("G3").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/R3C5"
Selection.AutoFill Destination:=Range("G3:G" & Range("A" & Rows.Count).End(xlUp).Row)
ActiveSheet.Columns("G").Copy
ActiveSheet.Columns("G").PasteSpecial xlPasteValues
'Calculating the % contribution to total - Ylan-Yde sheet
Sheets("interim").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/R1C5"
Selection.AutoFill Destination:=Range("G1:G" & Range("A" & Rows.Count).End(xlUp).Row)
ActiveSheet.Columns("G").Copy
ActiveSheet.Columns("G").PasteSpecial xlPasteValues
'Copying the Yland-Yde data back to the main shop data
Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.Copy
Sheets("raw").Select
lastRw = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lastRw + 1).Select
ActiveSheet.Paste
'Naming the newly created cols
Range("A1").Value = "M"
Range("A2").Value = ""
Range("F1").Value = "L"
Range("F2").Value = ""
Range("G1").Value = "%"
Range("G2").Value = ""
Range("B1").Select
Selection.Copy
Range("A1:A2").Select
Range("A2").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B1").Select
Selection.Copy
Range("F1:G2").Select
Range("G2").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Changing the format of the % contribution to %
Columns("G:G").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.00%"
'Adding the blue background
Range(Cells(1, "G"), Cells(Cells(Rows.Count, 1).End(xlUp).Row, "F")).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 16777200
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Adding the table borders
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
'Deleting the interim sheet
Sheets("interim").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
MsgBox "Whoop, whoop, that's all folks!"
End Sub
答案 0 :(得分：0)
在测试下面的代码之前，我建议您先复制工作簿。我不认为我有什么大碍或改变过任何重大问题，但谁知道。
cells / ranges都将与工作簿和工作表碰巧处于活动状态（代码正在运行）相关。Option Explicit放在代码之前。下面的代码假定您的interim和raw工作表与VBA代码位于同一工作簿中。
Option Explicit
Sub DataSetTransformation()
' Assumes "raw" and "interim" sheets are in the same workbook that your VBA code is in.
With ThisWorkbook ' If this is not true, refer to the workbook by name.
Dim rawSheet As Worksheet
Set rawSheet = .Worksheets("raw")
Dim interimSheet As Worksheet
On Error Resume Next
Set interimSheet = .Worksheets("interim")
On Error GoTo 0
If Not (interimSheet Is Nothing) Then
Application.DisplayAlerts = False
interimSheet.Delete
Application.DisplayAlerts = True
End If
Set interimSheet = .Worksheets.Add(After:=rawSheet)
interimSheet.Name = "interim"
End With
Dim rowIndex As Long
Dim columnIndex As Long
With rawSheet
For rowIndex = .Cells.SpecialCells(xlLastCell).Row To 2 Step -1
For columnIndex = .Cells.SpecialCells(xlLastCell).Column To 1 Step -1
With .Cells(rowIndex, columnIndex)
If (.Font.FontStyle <> "Bold") And Not (.Font.FontStyle = "Regular" And Not IsEmpty(.Value2)) Then
.EntireRow.Delete
Exit For ' I think you want to exit the loop early here (to return to column 1).
End If
End With
Next columnIndex
Next rowIndex
End With
'Removing the extra space in the amount column
With rawSheet
.Range("B1:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).Replace What:=" ", Replacement:="", SearchOrder:=xlByColumns
.Rows("1:2").Delete Shift:=xlUp
'Converting count & sum columns to numbers
.Columns("B:B").TextToColumns Destination:=.Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("D:D").TextToColumns Destination:=.Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Identifying the indent level
rowIndex = 2
Do While Trim(.Cells(rowIndex, "A")) <> ""
.Cells(rowIndex, "A").Offset(0, 4).Value = .Cells(rowIndex, "A").IndentLevel
rowIndex = rowIndex + 1
Loop
Dim cellFound As Range
Set cellFound = .Columns("A:A").Find("??????? ATLAS ????-???", LookIn:=xlValues)
With cellFound
' Always check if Range.Find found anything (even though I don't do this below); otherwise you will get an error when it didn't.
' Also, seems like you should be using Range.AutoFilter for this operation -- and copy-pasting all cells that are returned by the filter.
'Copying the Ylan-Yde data to a new sheet, pasting the Ylan-Yde data to the new sheet
.Range(cellFound, .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, cellFound.Column + 4)).Copy interimSheet.Range("A1")
End With
'Creating the column which says whether it is a main shop or Ylan-Yde
'Main shop
.Columns("A:A").Insert Shift:=xlToRight
.Range("B3").Copy .Range("A1")
.Range("A1").AutoFill Destination:=.Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
End With
'Ylan-Yde
With interimSheet
.Columns("A:A").Insert Shift:=xlToRight
.Range("B1").Copy .Range("A1")
.Range("A1").AutoFill Destination:=.Range("A1:A" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
'Deleting the Ylan-Yde data from the Atlas data
With rawSheet
' Again, seems like you should be using Range.AutoFilter for this.
Set cellFound = .Columns("B:B").Find("??????? ATLAS ????-???", LookIn:=xlValues)
.Rows(cellFound.Row & ":" & .Rows.Count).Delete
End With
'Deleting the total sum row
With interimSheet
.Cells(.Rows.Count, "A").End(xlUp).EntireRow.Delete
End With
'Calculating the % contribution to total - main shop sheet
With rawSheet
.Range("G3:G" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]/R3C5"
.Columns("G").Value2 = .Columns("G").Value2
End With
'Calculating the % contribution to total - Ylan-Yde sheet
With interimSheet
.Range("G1:G" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]/R1C5"
.Columns("G").Value2 = .Columns("G").Value2
Dim lastRw As Long
'Copying the Yland-Yde data back to the main shop data
.Range("A1:G" & Cells(.Rows.Count, "A").End(xlUp).Row).Copy
End With
With rawSheet
.Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, "A").PasteSpecial xlPasteAll
'Naming the newly created cols
.Range("A1").Value = "M"
.Range("A2").Value = ""
.Range("F1").Value = "L"
.Range("F2").Value = ""
.Range("G1").Value = "%"
.Range("G2").Value = ""
.Range("B1").Copy
.Range("A1:A2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("B1").Copy
.Range("F1:G2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Changing the format of the % contribution to %
With .Columns("G:G")
.Style = "Percent"
.NumberFormat = "0.00%"
End With
'Adding the blue background
With .Range("G1", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, "F"))
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 16777200
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
'Adding the table borders
Dim bordersToChange As Variant
bordersToChange = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
' You repeat yourself a lot when applying border styles. Maybe something like the below is effectively the same, but easier to maintain.
For rowIndex = LBound(bordersToChange) To UBound(bordersToChange)
With .Borders(bordersToChange(rowIndex))
.LineStyle = xlContinuous
.ThemeColor = 9
.TintAndShade = 0
.Weight = xlThin
End With
Next rowIndex
End With
End With
'Deleting the interim sheet
Application.DisplayAlerts = False
interimSheet.Delete
Application.DisplayAlerts = True
MsgBox "Whoop, whoop, that's all folks!"
End Sub
通常最好将较大/较长的过程分解为较小/较短的过程。