首先，我很抱歉標題令人困惑，但我不知道如何更好地解釋
基本上我期望 exel 宏在一個單元格內部=sum(F2:F3)而不是我得到=sum(F23:F27)
奇怪的是它Debug.print顯示了預期的結果
更新：我開始意識到問題不在于宏，而在于輸出表的行為。每次回圈進入字典 obj 時，宏都會在表中添加一個新行。每次添加新行時，所有前一行都會根據新行上的公式進行更改。關于如何阻止這種行為的任何想法？
完整代碼假設對資料進行排序，提取員工姓名并回傳總小時數。
這是一個資料示例：
這是完整的代碼
`Sub Sort_hours()
'
' Sort staff name and more
'
'
'add rounded column'
Range("F1").Value = "HoursRounded"
'select range cells with value different than blank'
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
'assign a name to the selection'
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = _
"Table1"
'convert into a table'
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight14"
ActiveSheet.ListObjects("Table1").Sort. _
SortFields.Clear
ActiveSheet.ListObjects("Table1").Sort. _
SortFields.Add key:=Range("Table1[[#All],[StaffName]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim lst As ListObject, c As Range, rw As ListRow, staff, indx As Long, hoursRoundedColumn As Long, hoursWorkedColumn As Long
Dim arrColors, dictColor As Object, dicFirstRow As Object, dicLastRow As Object, clrIndex As Long
Set dictColor = CreateObject("scripting.dictionary")
Set dictFirstRow = CreateObject("scripting.dictionary")
Set dictLastRow = CreateObject("scripting.dictionary")
Set lst = ActiveSheet.ListObjects("Table1")
indx = lst.ListColumns("StaffName").Index
hoursRoundedColumn = lst.ListColumns("HoursRounded").Index
hoursWorkedColumn = lst.ListColumns("HoursWorked").Index
arrColors = Array(RGB(204, 255, 153), RGB(153, 204, 255), RGB(255, 153, 255), RGB(255, 255, 153), RGB(204, 153, 255)) 'or whatever you like...
For Each rw In lst.ListRows
With rw.Range
'add rounded hours'
.Cells(hoursRoundedColumn).Formula = "=MROUND([@HoursWorked],0.5)"
staff = .Cells(indx).Value
If Not dictColor.exists(staff) Then 'new name? Store name and next color
clrIndex = dictColor.Count Mod (UBound(arrColors) 1) 'mod loops if more values than colors
'add new entry on dicts with new color and first raw'
dictColor.Add staff, arrColors(clrIndex)
dictFirstRow.Add staff, .Row
dictLastRow.Add staff, .Row
Else
dictLastRow(staff) = .Row
End If
.Interior.Color = dictColor(staff)
End With
Next rw
'add totals table'
Range("I1").Value = "StaffName"
Range("J1").Value = "SubTotal"
Range("K1").Value = "Variance"
Range("L1").Value = "Totals"
Range("I1:L1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = _
"TableTotals"
Dim TableTotals As ListObject
Set TableTotals = ActiveSheet.ListObjects("TableTotals")
TableTotals.TableStyle = "TableStyleLight14"
'add values to tableTotals'
Dim staffName As Variant
For Each staffName In dictFirstRow.keys
Dim newrow As ListRow
Set newrow = TableTotals.ListRows.Add
With newrow
.Range(1) = staffName
.Range(2).Formula = "=sum(F" & dictFirstRow(staffName) & ":F" & dictLastRow(staffName) & ")"
End With
Debug.Print staffName, dictFirstRow(staffName), dictLastRow(staffName)
Debug.Print "=sum(F" & dictFirstRow(staffName) & ":F" & dictLastRow(staffName) & ")"
Next staffName
End Sub
uj5u.com熱心網友回復：
見AutoFillFormulasInLists = False下文。這是一種讓我一開始就無法使用的“神奇”行為ListObject。
Sub Sort_hours()
Dim lst As ListObject, ws As Worksheet, TableTotals As ListObject
Dim c As Range, rw As ListRow, staff, indx As Long
Dim hoursRoundedColumn As Long, hoursWorkedColumn As Long
Dim arrColors, dictColor As Object, dictFirstRow As Object
Dim dictLastRow As Object, clrIndex As Long
Set ws = ActiveSheet 'or whatever
ws.Range("F1").Value = "HoursRounded" 'add rounded column
'create table from range and sort (grab the reference returned from the Add() )
Set lst = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)
With lst
.Name = "Table1"
.TableStyle = "TableStyleLight14"
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Table1[[#All],[StaffName]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Set dictColor = CreateObject("scripting.dictionary")
Set dictFirstRow = CreateObject("scripting.dictionary")
Set dictLastRow = CreateObject("scripting.dictionary")
indx = lst.ListColumns("StaffName").Index
hoursRoundedColumn = lst.ListColumns("HoursRounded").Index
hoursWorkedColumn = lst.ListColumns("HoursWorked").Index
arrColors = Array(RGB(204, 255, 153), RGB(153, 204, 255), _
RGB(255, 153, 255), RGB(255, 255, 153), _
RGB(204, 153, 255))
For Each rw In lst.ListRows
With rw.Range
.Cells(hoursRoundedColumn).Formula = "=MROUND([@HoursWorked],0.5)" 'add rounded hours
staff = .Cells(indx).Value
If Not dictColor.exists(staff) Then 'new name? Store name and next color
clrIndex = dictColor.Count Mod (UBound(arrColors) 1) 'mod loops if more values than colors
'add new entry on dicts with new color and first row
dictColor.Add staff, arrColors(clrIndex)
dictFirstRow.Add staff, .Row
End If
dictLastRow(staff) = .Row 'always runs...
.Interior.Color = dictColor(staff)
End With
Next rw
'add totals table'
ws.Range("I1").Resize(1, 4).Value = Array("StaffName", "SubTotal", "Variance", "Totals")
Set TableTotals = ws.ListObjects.Add(xlSrcRange, ws.Range("I1:L1"), , xlYes)
TableTotals.Name = "TableTotals"
TableTotals.TableStyle = "TableStyleLight14"
'### Prevent formulas from auto-filling ###
Application.AutoCorrect.AutoFillFormulasInLists = False '<<<<<<<<<
'add values to tableTotals'
For Each staff In dictFirstRow.keys
With TableTotals.ListRows.Add()
.Range(1) = staff
.Range(2).Formula = "=sum(F" & dictFirstRow(staff) & ":F" & dictLastRow(staff) & ")"
End With
Debug.Print staff, dictFirstRow(staff), dictLastRow(staff), _
"=sum(F" & dictFirstRow(staff) & ":F" & dictLastRow(staff) & ")"
Next staff
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/438572.html
上一篇：在Excel中計算F1分數
下一篇：作業表之間單元格的鏡像范圍