Formül hk.

[ozuberk]

Merhaba aşağıda bulunan makroyu çalıştırdığım zaman işlem çok uzun sürüyor. Acama başka bir yöntemi varmı?
Teşekkürler


Sub Deneme()
ActiveSheet.Name = "Deneme"
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Dim sat As Long, i As Long
sat = Sheets("Deneme").Cells(65536, "A").End(xlUp).Row
For i = 2 To sat
Sheets("Deneme").Cells(i, "B").Formula = "=SUBSTITUTE(RC[-1],""Deneme "","""")"
Sheets("Deneme").Cells(i, "C").Formula = "=YEAR(TODAY())&"" """
Sheets("Deneme").Cells(i, "D").Formula = "=SUBSTITUTE(RC[-2],RC[-1],"""")"
Next i

Columns("D").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Deneme1"
Columns("B").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
End Sub

 

[halit3]

Anladığım kadarı ile A sutünnundaki verileri ayırmak istiyorsunuz bu ko işinizi görür herhalde.

Sub ayır()
Columns("A:A").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=" ", FieldInfo:=Array(Array(1, 4), Array(1, 5), Array(1, 6))
ActiveWindow.ScrollColumn = 2
Range("D1").Select
End Sub

 

[halit3]

yada bunu deneyiniz.

Sub bul()
ActiveSheet.Name = "Deneme"
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim sat As Long, i As Long
sat = Sheets("Deneme").Cells(65536, "A").End(xlUp).Row
For i = 2 To sat
aranan = Sheets("Deneme").Cells(i, "A").Value
Sheets("Deneme").Cells(i, "A").Value = Right(aranan, 4)
Next i
End Sub

 

[ozuberk]

Halit bey teşekkür ederim, elinize sağlık.

 

[halit3]

Halit bey teşekkür ederim, elinize sağlık.

iyi çalışmalar