/ / Localizar colunas e formato como datas - excel, vba, excel-vba

Encontre colunas e formato como datas - excel, vba, excel-vba

Encontrei esse código em uma postagem diferente eestava me perguntando como eu poderia aplicar isso apenas ao Sheet3. Esse código funciona em todas as planilhas e eu não preciso disso. Alguém poderia me ajudar com isso? Muito obrigado. Sempre.

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

Respostas:

1 para resposta № 1

Substituir:

For Each ws In ThisWorkbook.Sheets

com:

Set ws = worksheets("Sheet3")

e remova o último Next

Espero que isto ajude.


0 para resposta № 2

Você pode fazer isso substituindo todas as referências de ws, que é a variável que mantém as folhas ao percorrer todas as planilhas, com ThisWorkbook.Sheets("Sheet3"). Teste o código a seguir, mas observe que não foi testado:

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

Saudações,


0 para resposta № 3

Substitua o

For Each ws In ThisWorkbook.Sheets

com

set ws = worksheets("sheet3")

e remova o

Next

no fim.