열 머리글 이 문자열 뒤에 임의의 숫자가 있는 열 이 있습니다. 첫 번째와 두 번째 발생을 특정 문자열로 변경하고 싶습니다. 열은 임의의 순서 일 수 있지만 더 낮은 숫자 (또는 숫자 없음)는 첫 번째 발생으로 간주됩니다.
입력:
| 이름 | date2 | place33 | 이름 2 | date14 | place666 |
|---|
산출:
| Transfer.name | Transfer.date | Transfer.place | Sender.name | Sender.date | Sender.place |
|---|
부동산 SearchOrder=xlnext이 첫 번째 값을 식별하는 데 도움이 되기를 바랐 지만 틀 렸습니다.
규칙은 열이 누락 된 경우에도 왼쪽에서 첫 번째 항목이로 플래그 지정된다는 것 Transfer.입니다.
와일드 카드 LookAt:=xlPart와 함께 옵션 을 사용하여 다양한 방법을 시도했지만 *아무 소용이 없었습니다.
내가 사용한 코드는 다음과 같습니다.
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("name", "date", "place", "name*", "date*", "place*")
rplcList = Array("Transfer.name", "Transfer.date", "Transfer.place",_
"Sender.name", "Sender.date", "Sender.place")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
On Error GoTo NextList:
Worksheets("Header").Rows(1).Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlWhole, SearchOrder:=xlNext, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'LookAt:= xlPart
Next x
다음은 검색어에 따라 그룹화 된 관심있는 모든 헤더를 수집하여 시작하는 한 가지 접근 방식입니다.
그런 다음 숫자 접미사 (있는 경우)에 따라 각 용어의 셀을 정렬하고 정렬 된 컬렉션의 첫 번째 항목에 레이블을 다시 지정합니다.
Sub RelabelHeaders()
Dim fndList As Variant
Dim c As Range, e
Dim dict, k, arr, tmp, col As Collection
Set dict = CreateObject("scripting.dictionary")
fndList = Array("name", "date", "place")
'collect all candidate headers: one collection per search term
For Each c In Worksheets("Header").Rows(1).SpecialCells(xlCellTypeConstants)
For Each e In fndList
'exact match or match+digit[s] (assumes one digit is followed by nothing or by other digits..)
If c.Value = e Or c.Value Like e & "#*" Then
If Not dict.exists(e) Then Set dict(e) = New Collection
dict(e).Add c
Exit For
End If
Next e
Next c
'loop keys, sort collection and relabel
For Each k In dict
Set col = dict(k)
SortCells col, k
col(1).Value = "Transfer." & k
If col.Count > 1 Then col(2).Value = "Sender." & k
Next k
End Sub
'sort a collection of cells ascending, according to the numeric part(if any)
' remaining after removing `root` from the value
Sub SortCells(col As Collection, root)
Dim num As Long, i As Long, j As Long
Dim Temp As Range, v1, v2
num = col.Count
For i = 1 To num - 1
For j = i + 1 To num
'compare based on numeric part only
v1 = NumberOnly(col(i).Value, root)
v2 = NumberOnly(col(j).Value, root)
If v1 > v2 Then
Set Temp = col(j)
col.Remove j
col.Add Temp, , i
End If
Next j
Next i
End Sub
'extract number from cell value (return 0 if no numerix suffix)
Function NumberOnly(v, root)
v = Replace(v, root, "")
If Len(v) = 0 Then v = 0
NumberOnly = CLng(v)
End Function
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다