Új hozzászólás Aktív témák

• #3026 Zoleeh csendes tag

  Új Válasz 2018-04-17 20:49:17 #3026

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Zoleeh

  csendes tag

  Sziasztok!

  Egy egyszerűnek tűnő, de számomra eddig megoldhatatlan feladatban szeretnék segítséget kérni. Adott egy letöltött excel fájl, amelynek egyik oszlopában ilyen formátumban szerepelnek a dátumok:
  2018.04.17. 17:30
  2018.04.17. 16:59
  2018.04.17. 14:54
  2018.04.17. 14:09
  A cellák formátuma "Általános", amely F2 és Enter után átalakul a kívánt dátumformátumra "éééé.hh.nn ó:pp". Ezt szeretném automatizálni egy makróval, átolvasva a fórumokat 3 megoldást találtam, de mindegyik ugyanott vérzik el.
  Vagyis, a makrófelvételnél minden tökéletesen működik, de ha a rögzített makrót futtatom az eredeti fájlon hibaüzenet nélkül lefutnak a makrók, de a cellák formátuma nem változik maradnak "Általános".
  A megoldásaim:
  1. Egy üres cellába "1" írok, majd másolás és a dátumok kijelölése után "Speciális beillesztés" Szorzás.
  Sub Rögzítés1()
'
' Rögzítés1 Makró
' Rögzítette: xy, dátum: 2018.04.17.
'

'
Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
ActiveCell.FormulaR1C1 = "1"
Selection.Copy
Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count - 1, 1)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

  2. A tartomány kijelölése után a ". " cseréje " "-ra
  Sub Rögzítés2()
'
' Rögzítés2 Makró
' Rögzítette: xy, dátum: 2018.04.17.
'

'
Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Select
Selection.Replace What:=". ", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

  3. A tartomány kijelölése után "Szövegből oszlopok"
  Sub Rögzítés3()
'
' Rögzítés3 Makró
' Rögzítette: xy, dátum: 2018.04.17.
'

'
Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End Sub

  Tudjátok mi lehet a megoldás? Vagy írjak egy makrót a For Sendkeys F2 Enter Next parancsok felhasználásával?

  Köszi

Új hozzászólás Aktív témák