/ / Znajdź kolumny i format jako daty - excel, vba, excel-vba

Znajdź kolumny i format jako daty - excel, vba, excel-vba

Znalazłem ten kod z innego posta i jazastanawiałem się, jak mogę to zastosować tylko do Sheet3. Ten kod działa przez wszystkie arkusze i nie potrzebuję tego. Czy ktoś mógłby mi w tym pomóc? Dziękuję bardzo. Zawsze.

Sub Sample()
Dim aCell As Range, bCell As Range
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim ExitLoop As Boolean

For Each ws In ThisWorkbook.Sheets
Set aCell = ws.Rows(1).Find(what:="Date", LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

ExitLoop = False

If Not aCell Is Nothing Then
Set bCell = aCell

ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"

lastRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & _
ws.Rows.Count).End(xlUp).Row

For i = 2 To lastRow
With ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i)
.FormulaR1C1 = .Value
End With
Next i

ws.Columns(aCell.Column).AutoFit

Do While ExitLoop = False
Set aCell = ws.Rows(1).FindNext(After:=aCell)

If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do

ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"

lastRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & _
ws.Rows.Count).End(xlUp).Row

For i = 2 To lastRow
ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i).FormulaR1C1 = _
ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i).Value
Next i
Else
ExitLoop = True
End If
Loop
End If
Next

Odpowiedzi:

1 dla odpowiedzi № 1

Zastąpić:

For Each ws In ThisWorkbook.Sheets

z:

Set ws = worksheets("Sheet3")

i usuń ostatni Next

Mam nadzieję że to pomoże.


0 dla odpowiedzi nr 2

Możesz to zrobić, zastępując wszystkie odniesienia do ws, która jest zmienną przechowującą arkusze podczas przechodzenia przez wszystkie arkusze, za pomocą ThisWorkbook.Sheets("Sheet3"). Przetestuj poniższy kod, ale pamiętaj, że jest on niesprawdzony:

Sub Sample()
Dim aCell As Range, bCell As Range
Dim lastRow As Long, i As Long
Dim ExitLoop As Boolean

Set aCell = ThisWorkbook.Sheets("Sheet3").Rows(1).Find(what:="Date", LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

ExitLoop = False

If Not aCell Is Nothing Then
Set bCell = aCell

ThisWorkbook.Sheets("Sheet3").Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"

lastRow = ThisWorkbook.Sheets("Sheet3").Range(Split(ThisWorkbook.Sheets("Sheet3").Cells(, aCell.Column).Address, "$")(1) & _
ThisWorkbook.Sheets("Sheet3").RoThisWorkbook.Sheets("Sheet3").Count).End(xlUp).Row

For i = 2 To lastRow
With ThisWorkbook.Sheets("Sheet3").Range(Split(ThisWorkbook.Sheets("Sheet3").Cells(, aCell.Column).Address, "$")(1) & i)
.FormulaR1C1 = .Value
End With
Next i

ThisWorkbook.Sheets("Sheet3").Columns(aCell.Column).AutoFit

Do While ExitLoop = False
Set aCell = ThisWorkbook.Sheets("Sheet3").Rows(1).FindNext(After:=aCell)

If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do

ThisWorkbook.Sheets("Sheet3").Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"

lastRow = ThisWorkbook.Sheets("Sheet3").Range(Split(ThisWorkbook.Sheets("Sheet3").Cells(, aCell.Column).Address, "$")(1) & _
ThisWorkbook.Sheets("Sheet3").RoThisWorkbook.Sheets("Sheet3").Count).End(xlUp).Row

For i = 2 To lastRow
ThisWorkbook.Sheets("Sheet3").Range(Split(ThisWorkbook.Sheets("Sheet3").Cells(, aCell.Column).Address, "$")(1) & i).FormulaR1C1 = _
ThisWorkbook.Sheets("Sheet3").Range(Split(ThisWorkbook.Sheets("Sheet3").Cells(, aCell.Column).Address, "$")(1) & i).Value
Next i
Else
ExitLoop = True
End If
Loop
End If

End Sub

Pozdrowienia,


0 dla odpowiedzi № 3

Zastąp

For Each ws In ThisWorkbook.Sheets

z

set ws = worksheets("sheet3")

i usuń

Next

na końcu.