EXCEL MAKRO İLE EŞLEŞMEYEN KAYITLARI BULMA

Anonim
2017-05-06T12:39:38+00:00

Merhaba,

Excel'de birden fazla kolondaki verileri karşılaştırarak eşleşmeyen kayıtları buluyorum ancak aşağıdaki kodla karşılıklı olarak 100.000 satırın üzerindeki verileri karşılaştırdığımda işin sonuçlanması uzun sürüyor.

Bu makroyu nasıl hızlandıra bilirim yardımcı olursanız sevinirim.

'Created By Erkut 23.08.2010

Sub NoMatch()

Dim r As Long, lastrow As Long, rr As Long

Dim res As Variant

Columns("F:F").Select

Selection.ClearContents

Columns("L:L").Select

Selection.ClearContents

Columns("M:M").Select

Selection.ClearContents

Sheets("ESLESMEYENLER").Select

    Cells.Select

    Selection.Delete Shift:=xlUp

    Range("A1").Select

'****************************************************************************

Sheets("VERI").Select

Range("G2").Select

    'Selection.End(xlToRight).Select

    Selection.End(xlDown).Select

    'ActiveCell.Offset(0, 1).Select

    ActiveCell.Offset(0, 6).Value = "1"

    'ActiveCell.Offset(1, 0).Select

    'ActiveCell.FormulaR1C1 = "1"

    Selection.End(xlUp).Select

    Range("M2").Select

    ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-1]"

    'Range("P2").Select

    'ActiveCell.FormulaR1C1 = "=IF(RC[-7]=""B"",RC[-6]*-1,RC[-6]*1)"

    Selection.Copy

    Range(Selection, Selection.End(xlDown)).Select

    ActiveSheet.Paste

    'Range("M2").Select

    'Range(Selection, Selection.End(xlDown)).Select

    'Application.CutCopyMode = False

    'Selection.Copy

    'Range("J2").Select

    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

    '    :=False, Transpose:=False

    'Columns("P:P").Select

    'Application.CutCopyMode = False

    'Selection.ClearContents

    'Columns("J:J").Select

    'Selection.NumberFormat = "#,##0.00"

    'Range("J2").Select

'****************************************************************************

Range("a1").Select

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

rr = 1

For r = 2 To lastrow

'A ve B kolunundaki verileri G ve H kolonu ile eşleştiriyorum gerekiyor.

 ' A kolonundaki veri b kolonundakilerle eşleştir.

q = Cells(r, "A") & Cells(r, "B")

res = Application.Match(q, Range("M:M"), 0)

If IsError(res) Then

Cells(r, "F").Value = "N"

Else

'MsgBox res

If Cells(res, "L").Value = "N" Then Cells(r, "F").Value = "N" Else Cells(res, "L").Value = "N"

End If

rr = rr + 1

Next r

Columns("M:M").Select

Selection.ClearContents

'****************************************************************************

'ESLESMEYENLERI FARKLI SHEET'E AKTARMA

Worksheets("ESLESMEYENLER").Select

Cells.Select

Cells.Clear

Range("A1").Value = "NO"

Range("B1").Value = "TUTAR"

Range("C1").Value = "VERI 3"

Range("D1").Value = "VERI 4"

Range("E1").Value = "VERI 5"

Range("G1").Value = "NO"

Range("H1").Value = "TUTAR"

Range("I1").Value = "VERI 3"

Range("J1").Value = "VERI 4"

Range("K1").Value = "VERI 5"

'********************************

Worksheets("VERI").Select

Range("A1").Select

ky = 0

y = 2

x = satır

y = 2

For x = 2 To 150000

'Banka = (Worksheets("SWITCH OZET").Cells(x, 2).Value)

If Worksheets("VERI").Cells(x, 6).Value = "N" Then

Worksheets("ESLESMEYENLER").Cells(y, 1).Value = Worksheets("VERI").Cells(x, 1)

Worksheets("ESLESMEYENLER").Cells(y, 2).Value = Worksheets("VERI").Cells(x, 2)

Worksheets("ESLESMEYENLER").Cells(y, 3).Value = Worksheets("VERI").Cells(x, 3)

Worksheets("ESLESMEYENLER").Cells(y, 4).Value = Worksheets("VERI").Cells(x, 4)

Worksheets("ESLESMEYENLER").Cells(y, 5).Value = Worksheets("VERI").Cells(x, 5)

y = y + 1

End If

If Worksheets("VERI").Cells(x, 12).Value = "" Then

Worksheets("ESLESMEYENLER").Cells(y, 7).Value = Worksheets("VERI").Cells(x, 7)

Worksheets("ESLESMEYENLER").Cells(y, 8).Value = Worksheets("VERI").Cells(x, 8)

Worksheets("ESLESMEYENLER").Cells(y, 9).Value = Worksheets("VERI").Cells(x, 9)

Worksheets("ESLESMEYENLER").Cells(y, 10).Value = Worksheets("VERI").Cells(x, 10)

Worksheets("ESLESMEYENLER").Cells(y, 11).Value = Worksheets("VERI").Cells(x, 11)

y = y + 1

End If

If Worksheets("VERI").Cells(x, 1) = "" And Worksheets("VERI").Cells(x, 7) = "" Then GoTo 2

Next x

'****************************************************************************

2

Sheets("VERI").Select

'FORMAT DÜZENLEMESİ

Sheets("ESLESMEYENLER").Select

    Columns("A:E").Select

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

        "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortTextAsNumbers

    With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

        .SetRange Range("A:E")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    Columns("G:K").Select

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

        "G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortTextAsNumbers

    With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

        .SetRange Range("G:K")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    Cells.Select

    With Selection.Font

        .Name = "Arial"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    Cells.EntireColumn.AutoFit

    Range("A1:E1").Select

    With Selection.Font

        .Color = -16776961

        .TintAndShade = 0

    End With

    Selection.Font.Bold = True

    Range("G1:K1").Select

    Selection.Font.Bold = True

    With Selection.Font

        .Color = -16776961

        .TintAndShade = 0

    End With

    Columns("B:B").Select

    Selection.NumberFormat = "#,##0.00"

    Columns("H:H").Select

    Selection.NumberFormat = "#,##0.00"

    Range("A1").Select

'****************************************************************************

MsgBox "THE END"

End Sub

Microsoft 365 ve Office | Excel | Ev için | Windows

Kilitli Soru. Bu soru Microsoft Destek Topluluğu’ndan aktarıldı. Yararlı olup olmadığını belirtmek için oy verebilirsiniz ancak yorum veya yanıt ekleyemez ya da soruyu takip edemezsiniz.

0 yorum

4 yanıt

Sıralama ölçütü: En yararlı
En yararlı En Yeni En Eski
  1. Anonim
    2017-05-09T08:10:36+00:00

    Merhaba Özgehan,

    Yönlendirmeniz için teşekkürler.

    Konu ile ilgili TechNet birimine sorumu sordum.

    İyi günler.

    Erkut

    Bu yanıt yardımcı oldu mu?

    0 yorum
  2. Anonim
    2017-05-09T07:09:17+00:00

    Merhaba erkuta,

    Excel'de makro vb. işlemler için TechNet birimiz destek vermektedir. Lütfen aşağıdaki bağlantı aracılığı ile uzmanlarımıza sorunuzu iletiniz.

    TechNet Türkiye

    Yardımcı olmamızı istediğiniz başka bir konu var ise, lütfen bildiriniz.

    Mutlu günler,

    Özgehan

    Bu yanıt yardımcı oldu mu?

    0 yorum
  3. Anonim
    2017-05-08T06:15:58+00:00

    Merhaba Kubilay,

    Öncelikle ilginiz için teşekkürler.

    kopyalama yapıştırmaya ait işlemler fazla vakit almıyor.

    Sorun eşleşmeyen kayıtları bulmaya çalıştığım aşağıda kodları 25K lık bir data üzerinde çalıştırdığımda 01:22 dakika sürüyor, ancak aynı kodu 100K lık bir data üzerinde çalıştırdığımda ise bu süre 25:00 dakikaya çıkıyor.

    Benim amacım bu süreyi azaltmak.

    *******************************************************

    Sub NoMatch()

    Application.ScreenUpdating = False

    Dim r As Long, lastrow As Long, rr As Long

    Dim res As Variant

    Dim StartTime As Double

    Dim MinutesElapsed As String

    StartTime = Timer

    Columns("F:F").Select

    Selection.ClearContents

    Columns("L:L").Select

    Selection.ClearContents

    Columns("M:M").Select

    Selection.ClearContents

    Sheets("ESLESMEYENLER").Select

        Range("a1").CurrentRegion.Clear

    '****************************************************************************

    Sheets("VERI").Select

    Range("G2").Select

        Selection.End(xlDown).Select

        ActiveCell.Offset(0, 6).Value = "1"

        Selection.End(xlUp).Select

        Range("M2").Select

        ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-1]"

        Selection.Copy

        Range(Selection, Selection.End(xlDown)).PasteSpecial

    '****************************************************************************

    Range("a1").Select

    'lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    lastrow = Range("a150000").End(xlUp).Row

    rr = 1

    For r = 2 To lastrow

    'A ve B kolunundaki verileri G ve H kolonu ile eşleştiriyorum.

     ' A kolonundaki veriyi b kolonundakilerle eşleştir.

    q = Cells(r, "A") & Cells(r, "B")

    res = Application.Match(q, Range("M:M"), 0)

    If IsError(res) Then

    Cells(r, "F").Value = "N"

    Else

    If Cells(res, "L").Value = "N" Then Cells(r, "F").Value = "N" Else Cells(res, "L").Value = "N"

    End If

    rr = rr + 1

    Next r

    Columns("M:M").ClearContents

    '****************************************************************************

    Application.ScreenUpdating = True

    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    MsgBox "Time " & MinutesElapsed & " minutes", vbInformation

    MsgBox "THE END"

    End Sub

    Bu yanıt yardımcı oldu mu?

    0 yorum
  4. Anonim
    2017-05-06T20:52:19+00:00

    Merhaba,

    Excel'de birden fazla kolondaki verileri karşılaştırarak eşleşmeyen kayıtları buluyorum ancak aşağıdaki kodla karşılıklı olarak 100.000 satırın üzerindeki verileri karşılaştırdığımda işin sonuçlanması uzun sürüyor.

    Bu makroyu nasıl hızlandıra bilirim yardımcı olursanız sevinirim.

    'Created By Erkut 23.08.2010

    Sub NoMatch()

    Dim r As Long, lastrow As Long, rr As Long

    Dim res As Variant

    Columns("F:F").Select

    Selection.ClearContents

        

    Columns("L:L").Select

    Selection.ClearContents

    Columns("M:M").Select

    Selection.ClearContents

    Sheets("ESLESMEYENLER").Select

        Cells.Select

        Selection.Delete Shift:=xlUp

        Range("A1").Select

        

    '****************************************************************************

    Sheets("VERI").Select

    Range("G2").Select

        'Selection.End(xlToRight).Select

        Selection.End(xlDown).Select

        'ActiveCell.Offset(0, 1).Select

        ActiveCell.Offset(0, 6).Value = "1"

        

        'ActiveCell.Offset(1, 0).Select

        'ActiveCell.FormulaR1C1 = "1"

        Selection.End(xlUp).Select

        Range("M2").Select

        ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-1]"

        'Range("P2").Select

        'ActiveCell.FormulaR1C1 = "=IF(RC[-7]=""B"",RC[-6]*-1,RC[-6]*1)"

        Selection.Copy

        Range(Selection, Selection.End(xlDown)).Select

        ActiveSheet.Paste

        'Range("M2").Select

        'Range(Selection, Selection.End(xlDown)).Select

        'Application.CutCopyMode = False

        'Selection.Copy

        'Range("J2").Select

        'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        '    :=False, Transpose:=False

        'Columns("P:P").Select

        'Application.CutCopyMode = False

        'Selection.ClearContents

        'Columns("J:J").Select

        'Selection.NumberFormat = "#,##0.00"

        'Range("J2").Select

    '****************************************************************************

    Range("a1").Select

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    rr = 1

    For r = 2 To lastrow

    'A ve B kolunundaki verileri G ve H kolonu ile eşleştiriyorum gerekiyor.

     ' A kolonundaki veri b kolonundakilerle eşleştir.

    q = Cells(r, "A") & Cells(r, "B")

    res = Application.Match(q, Range("M:M"), 0)

    If IsError(res) Then

    Cells(r, "F").Value = "N"

    Else

    'MsgBox res

    If Cells(res, "L").Value = "N" Then Cells(r, "F").Value = "N" Else Cells(res, "L").Value = "N"

    End If

    rr = rr + 1

    Next r

    Columns("M:M").Select

    Selection.ClearContents

    '****************************************************************************

    'ESLESMEYENLERI FARKLI SHEET'E AKTARMA

    Worksheets("ESLESMEYENLER").Select

    Cells.Select

    Cells.Clear

    Range("A1").Value = "NO"

    Range("B1").Value = "TUTAR"

    Range("C1").Value = "VERI 3"

    Range("D1").Value = "VERI 4"

    Range("E1").Value = "VERI 5"

    Range("G1").Value = "NO"

    Range("H1").Value = "TUTAR"

    Range("I1").Value = "VERI 3"

    Range("J1").Value = "VERI 4"

    Range("K1").Value = "VERI 5"

    '********************************

    Worksheets("VERI").Select

    Range("A1").Select

    ky = 0

    y = 2

    x = satır

    y = 2

    For x = 2 To 150000

    'Banka = (Worksheets("SWITCH OZET").Cells(x, 2).Value)

    If Worksheets("VERI").Cells(x, 6).Value = "N" Then

    Worksheets("ESLESMEYENLER").Cells(y, 1).Value = Worksheets("VERI").Cells(x, 1)

    Worksheets("ESLESMEYENLER").Cells(y, 2).Value = Worksheets("VERI").Cells(x, 2)

    Worksheets("ESLESMEYENLER").Cells(y, 3).Value = Worksheets("VERI").Cells(x, 3)

    Worksheets("ESLESMEYENLER").Cells(y, 4).Value = Worksheets("VERI").Cells(x, 4)

    Worksheets("ESLESMEYENLER").Cells(y, 5).Value = Worksheets("VERI").Cells(x, 5)

    y = y + 1

    End If

    If Worksheets("VERI").Cells(x, 12).Value = "" Then

    Worksheets("ESLESMEYENLER").Cells(y, 7).Value = Worksheets("VERI").Cells(x, 7)

    Worksheets("ESLESMEYENLER").Cells(y, 8).Value = Worksheets("VERI").Cells(x, 8)

    Worksheets("ESLESMEYENLER").Cells(y, 9).Value = Worksheets("VERI").Cells(x, 9)

    Worksheets("ESLESMEYENLER").Cells(y, 10).Value = Worksheets("VERI").Cells(x, 10)

    Worksheets("ESLESMEYENLER").Cells(y, 11).Value = Worksheets("VERI").Cells(x, 11)

    y = y + 1

    End If

    If Worksheets("VERI").Cells(x, 1) = "" And Worksheets("VERI").Cells(x, 7) = "" Then GoTo 2

    Next x

    '****************************************************************************

    2

    Sheets("VERI").Select

    'FORMAT DÜZENLEMESİ

        

    Sheets("ESLESMEYENLER").Select

        Columns("A:E").Select

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

            "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

            xlSortTextAsNumbers

        With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

            .SetRange Range("A:E")

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .SortMethod = xlPinYin

            .Apply

        End With

        Columns("G:K").Select

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

            "G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

            xlSortTextAsNumbers

        With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

            .SetRange Range("G:K")

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .SortMethod = xlPinYin

            .Apply

        End With

        Cells.Select

        With Selection.Font

            .Name = "Arial"

            .Size = 8

            .Strikethrough = False

            .Superscript = False

            .Subscript = False

            .OutlineFont = False

            .Shadow = False

            .Underline = xlUnderlineStyleNone

            .ColorIndex = xlAutomatic

            .TintAndShade = 0

            .ThemeFont = xlThemeFontNone

        End With

        Cells.EntireColumn.AutoFit

        Range("A1:E1").Select

        With Selection.Font

            .Color = -16776961

            .TintAndShade = 0

        End With

        Selection.Font.Bold = True

        Range("G1:K1").Select

        Selection.Font.Bold = True

        With Selection.Font

            .Color = -16776961

            .TintAndShade = 0

        End With

        Columns("B:B").Select

        Selection.NumberFormat = "#,##0.00"

        Columns("H:H").Select

        Selection.NumberFormat = "#,##0.00"

        Range("A1").Select

    '****************************************************************************

    MsgBox "THE END"

    End Sub

    Merhaba Erkuta;

    Veriyi göremediğim için size yalnızca bir kaç noktada yardımcı olabilirim.

    150K satırlık veride işlem yaptığınızı söylediniz. Ancak bazı yerlerde tüm sayfa üzerinde düzenlemeler, silme işlemleri vb. işlemler gerçekleştirmişsiniz. Sadece verilerin olduğu aralıkta bu işlemleri yaparsanız, biraz daha zaman kazanabilirsiniz.

    Ayrıca, 150K satırlık veriyi hücre hücre kopyalayıp yapıştırmışsınız, bunu filtreleyip yaparsanız, daha hızlı olacaktır.

    Aşağıdaki kodu adım adım çalıştırarak kontrol ediniz lütfen, Bir fikir verecektir size.

    Sub NoMatch()

    Dim r As Long, lastrow As Long, rr As Long

    Dim res As Variant

    Columns("F:F").Select

    Selection.ClearContents

    Columns("L:L").Select

    Selection.ClearContents

    Columns("M:M").Select

    Selection.ClearContents

    Sheets("ESLESMEYENLER").Select

        Range("a1").CurrentRegion.Clear

    '****************************************************************************

    Sheets("VERI").Select

    Range("G2").Select

        'Selection.End(xlToRight).Select

        Selection.End(xlDown).Select

        'ActiveCell.Offset(0, 1).Select

        ActiveCell.Offset(0, 6).Value = "1"

        'ActiveCell.Offset(1, 0).Select

        'ActiveCell.FormulaR1C1 = "1"

        Selection.End(xlUp).Select

        Range("M2").Select

        ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-1]"

        'Range("P2").Select

        'ActiveCell.FormulaR1C1 = "=IF(RC[-7]=""B"",RC[-6]*-1,RC[-6]*1)"

        Selection.Copy

        Range(Selection, Selection.End(xlDown)).PasteSpecial

        'Range("M2").Select

        'Range(Selection, Selection.End(xlDown)).Select

        'Application.CutCopyMode = False

        'Selection.Copy

        'Range("J2").Select

        'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        '    :=False, Transpose:=False

        'Columns("P:P").Select

        'Application.CutCopyMode = False

        'Selection.ClearContents

        'Columns("J:J").Select

        'Selection.NumberFormat = "#,##0.00"

        'Range("J2").Select

    '****************************************************************************

    Range("a1").Select

    lastrow = Range("a1000000").End(xlUp).Row

    rr = 1

    For r = 2 To lastrow

    'A ve B kolunundaki verileri G ve H kolonu ile eşleştiriyorum gerekiyor.

     ' A kolonundaki veri b kolonundakilerle eşleştir.

    q = Cells(r, "A") & Cells(r, "B")

    res = Application.Match(q, Range("M:M"), 0)

    If IsError(res) Then

    Cells(r, "F").Value = "N"

    ElseIf Cells(res, "L").Value = "N" Then

    Cells(r, "F").Value = "N"

    Else

    Cells(res, "L").Value = "N"

    End If

    rr = rr + 1

    Next r

    Columns("M:M").ClearContents

    '****************************************************************************

    'ESLESMEYENLERI FARKLI SHEET'E AKTARMA

    Worksheets("ESLESMEYENLER").Select

    Range("a1").CurrentRegion.Clear

    Range("A1").Value = "NO"

    Range("B1").Value = "TUTAR"

    Range("C1").Value = "VERI 3"

    Range("D1").Value = "VERI 4"

    Range("E1").Value = "VERI 5"

    Range("G1").Value = "NO"

    Range("H1").Value = "TUTAR"

    Range("I1").Value = "VERI 3"

    Range("J1").Value = "VERI 4"

    Range("K1").Value = "VERI 5"

    '********************************

    Worksheets("VERI").Select

    Range("A1").Select

    'Banka = (Worksheets("SWITCH OZET").Cells(x, 2).Value)

    Sheets("VERI").Select

    Range("a1").AutoFilter 6, Criteria:="N"

    Range(Range("A1:E1"), Range("A1:E1").End(xlDown)).Copy

    Sheets("ESLESMEYENLER").Select

    Range("a1").PasteSpecial

    Sheets("VERI").Select

    Range("a1").AutoFilter

    Range("a1").AutoFilter 12, Criteria:=""""

    Range(Range("G1:K1"), Range("G1:K1").End(xlDown)).Copy

    Sheets("ESLESMEYENLER").Select

    Range("G1").PasteSpecial

    for x = 2 to 150000

    If Worksheets("VERI").Cells(x, 1) = "" And Worksheets("VERI").Cells(x, 7) = "" Then GoTo 2

    Next x

    '****************************************************************************

    2

    Sheets("VERI").Select

    'FORMAT DÜZENLEMESİ

    Sheets("ESLESMEYENLER").Select

        Columns("A:E").Select

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

            "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

            xlSortTextAsNumbers

        With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

            .SetRange Range("A:E")

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .SortMethod = xlPinYin

            .Apply

        End With

        Columns("G:K").Select

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort.SortFields.Add Key:=Range( _

            "G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

            xlSortTextAsNumbers

        With ActiveWorkbook.Worksheets("ESLESMEYENLER").Sort

            .SetRange Range("G:K")

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .SortMethod = xlPinYin

            .Apply

        End With

        Cells.Select

        With Selection.Font

            .Name = "Arial"

            .Size = 8

            .Strikethrough = False

            .Superscript = False

            .Subscript = False

            .OutlineFont = False

            .Shadow = False

            .Underline = xlUnderlineStyleNone

            .ColorIndex = xlAutomatic

            .TintAndShade = 0

            .ThemeFont = xlThemeFontNone

        End With

        Range("A:K").EntireColumn.AutoFit

        Range("A1:E1").Select

        With Selection.Font

            .Color = -16776961

            .TintAndShade = 0

        End With

        Selection.Font.Bold = True

        Range("G1:K1").Select

        Selection.Font.Bold = True

        With Selection.Font

            .Color = -16776961

            .TintAndShade = 0

        End With

        Columns("B:B").Select

        Selection.NumberFormat = "#,##0.00"

        Columns("H:H").Select

        Selection.NumberFormat = "#,##0.00"

        Range("A1").Select

    '****************************************************************************

    MsgBox "THE END"

    End Sub

    Bu yanıt yardımcı oldu mu?

    0 yorum