/ / Trouver des colonnes et un format comme dates - excel, vba, excel-vba

Recherchez des colonnes et un format comme dates - excel, vba, excel-vba

J'ai trouvé ce code à partir d'une publication différente et jeJe me demandais comment je pouvais appliquer cela uniquement à la Sheet3. Ce code fonctionne à travers toutes les feuilles et je n’en ai pas besoin. Quelqu'un pourrait-il m'aider avec cela? Merci beaucoup. Toujours.

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

Réponses:

1 pour la réponse № 1

Remplacer:

For Each ws In ThisWorkbook.Sheets

avec:

Set ws = worksheets("Sheet3")

et enlever le dernier Next

J'espère que cela t'aides.


0 pour la réponse № 2

Vous pouvez accomplir cela en remplaçant toutes les références de ws, qui est la variable contenant les feuilles lors de la lecture en boucle de toutes les feuilles de calcul, avec ThisWorkbook.Sheets("Sheet3"). Veuillez tester le code suivant en notant qu'il n'a pas été testé:

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

Cordialement,


0 pour la réponse № 3

Remplace le

For Each ws In ThisWorkbook.Sheets

avec

set ws = worksheets("sheet3")

et retirez le

Next

à la fin.