對于我最新的好主意，我需要將變數表的參考更改為另一張表中的下一列。我創建了一個現有作業表 ("INL") 的副本，所以我得到 ("INL(2)),("INL(3)"),....,("INL(n)") 中的參考這些作業表應更新到作業表 ("Info") 中的下一列，以便 ("INL B:B") 中的公式參考 ("Info C:C), ("INL (2)B:B")參考（“Info D:D”）... INL (n) 到 Info (x)。
我嘗試了類似下面的代碼，但現在我被卡住了。
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim rng As Range
Set ws= Sheets("INL") Or ws.Name Like ("'INL (*)'")
For Each ws In ThisWorkbook.Sheets
Set rng = ws.Range("C:C")
For Each cell In rng
cell.Formula = Replace(cell.Formula, "=Info!C", "=Info!(=COLUMN(C24)-2)")
Next Cell
Next ws
Application.ScreenUpdating = True
End Sub
有沒有人有處理這個問題的好方法？
uj5u.com熱心網友回復：
嘗試：
Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim rng As Range
Dim c As Range
Dim varCopy As Variant
Dim strCol As String
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
If Left(ws.Name, 3) = "INL" Then
If ws.Name = "INL" Then
varCopy = Array(1, 1) 'An exception case to handle 1st sheet which has no number in it.
Else
varCopy = Split(ws.Name, ")") 'Step 1 of getting sheet copy number.
varCopy = Split(varCopy(0), "(") 'step 2. Copy # will be element 1 in 0 indexed array.
End If
Set rng = ws.Range("B:B") 'Question suggests this should be col B, not C. I would recommend limiting the range only to affected rows...
'...rather than looping through the >1 million rows that are in each column.
strCol = Columns(CLng(varCopy(1)) 1).Address 'Column number is 1 more than sheet copy number.
strCol = Mid(strCol, InStr(1, strCol, ":", vbTextCompare) 1, 100) 'Getting text to right of : ensures including columns AA and higher, if needed.
For Each c In rng.Cells
c.Replace What:="Info!C", Replacement:="Info!" & strCol, LookAt:=xlPart 'Changed your line to use the appropriate Replace method.
Next c
End If
Next ws
Application.ScreenUpdating = True
Set rng = Nothing
Set ws = Nothing
End Sub
uj5u.com熱心網友回復：
作業表復制索引與列號
- 我假設 中的參考
INL是正確的，并且代碼只會修改副本中的參考。如果不是這種情況，您將不得不修改代碼。 - 我還假設參考是簡單和相對的（
$對于列沒有），例如=Info!C2. - 無論如何，我
Debug.Print在代碼中留下了連續三行，以便您更好地了解發生了什么。
Option Explicit
Private Sub CommandButton2_Click()
ReplaceReferences
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Replaces cell references...
' Calls: IntColumnNumber,StrStringBetweenTwoChars,StrColumnString
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ReplaceReferences()
Const sName As String = "INL"
Const sCol As String = "B"
Const sfRow As Long = 2
Const dName As String = "Info"
Const dfCol As String = "C"
Const dColDiff As Long = 1 ' don't change: related to (2),(3)...
Dim dNameExclam As String
If UBound(Split(dName)) > 0 Then
dNameExclam = "'" & dName & "'!"
Else
dNameExclam = dName & "!"
End If
Dim FindString As String: FindString = dNameExclam & dfCol
Dim dfColNum As Long: dfColNum = IntColumnNumber(dfCol)
Application.ScreenUpdating = False
Dim sws As Worksheet
Dim srg As Range
Dim scrg As Range
Dim swsNum As String
Dim swsName As String
Dim ReplaceString As String
Dim dColString As String
For Each sws In ThisWorkbook.Worksheets
swsName = sws.Name
If UCase(swsName) Like UCase(sName) & " (*)" Then
swsNum = StrStringBetweenTwoChars(swsName, "(", ")")
If IsNumeric(swsNum) Then
dColString = StrColumnString(dfColNum swsNum - dColDiff)
With sws.Columns(sCol)
Set srg = .Resize(.Rows.Count - sfRow 1).Offset(sfRow - 1)
End With
Set scrg = Intersect(sws.UsedRange, srg)
If Not scrg Is Nothing Then
ReplaceString = dNameExclam & dColString
Debug.Print "Range: '" & sws.Name & "!" & scrg.Address(0, 0) & "'"
Debug.Print "'" & FindString & "' to '"; ReplaceString & "'"
Debug.Print "FirstCell formula: '" & scrg.Cells(1).Formula & "'"
' This may not work as expected when you will need to loop.
scrg.Formula = Replace(scrg.Cells(1).Formula, _
FindString, ReplaceString, , , vbTextCompare)
Set scrg = Nothing
End If
End If
End If
Next sws
Application.ScreenUpdating = True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the Excel column number from a (column) string.
' Remarks: Restricted only by 'ColumnNumber As Long', i.e., e.g.:
' Debug.Print IntColumnNumber("FXSHRXW") ' = 2147483647
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IntColumnNumber( _
ByVal ColumnString As String) _
As Double
Const ProcName As String = "IntColumnNumber"
On Error GoTo ClearError
Dim ColumnStringLength As Long: ColumnStringLength = Len(ColumnString)
If ColumnStringLength = 0 Then Exit Function
Dim n As Long
Dim CharNumber As Long
Dim CharIndex As Long
Dim ColumnNumber As Long
For n = ColumnStringLength To 1 Step -1
CharNumber = Asc(UCase(Mid(ColumnString, n))) - 64
If CharNumber < 1 Or CharNumber > 26 Then
Exit Function
End If
ColumnNumber = ColumnNumber CharNumber * 26 ^ CharIndex
CharIndex = CharIndex 1
Next
IntColumnNumber = ColumnNumber
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the Excel column string from a (column) number.
' Remarks: Restricted only by 'ColumnNumber As Long', i.e., e.g.:
' Debug.Print StrColumnString(2147483647) ' = "FXSHRXW"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrColumnString( _
ByVal ColumnNumber As Long) _
As String
Const ProcName As String = "StrColumnString"
On Error GoTo ClearError
Dim ColumnString As String
Dim Remainder As Long
Do
Remainder = (ColumnNumber - 1) Mod 26
ColumnString = Chr(Remainder 65) & ColumnString
ColumnNumber = Int((ColumnNumber - Remainder) \ 26)
Loop Until ColumnNumber = 0
StrColumnString = ColumnString
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the string between two characters exclusively.
' Remarks: Only the first occurrence of the characters is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrStringBetweenTwoChars( _
ByVal SearchString As String, _
ByVal FirstChar As String, _
ByVal SecondChar As String) _
As String
Dim fcPos As Long: fcPos = InStr(1, SearchString, FirstChar, vbTextCompare)
If fcPos = 0 Then Exit Function
Dim scPos As Long: scPos = InStr(1, SearchString, SecondChar, vbTextCompare)
If scPos <= fcPos Then Exit Function
StrStringBetweenTwoChars _
= Mid(SearchString, fcPos 1, scPos - fcPos - 1)
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/402304.html
標籤：