Soru excel alt no ve durum verisini getirme

[izzetk]

Sayın Üyeler Merhaba, bir sorun olacak Soldaki ana listede aynı barkod numarasından alt no.su ve durum açıklamaları farklı olan uzun bir liste var.
6850310227'den solda 3 adet var sağdaki liste de bir adet var. Bunu hangi formül ile alt alta çoğaltıp soldaki listeye bakıp "alt no" ve "durum"da yazanları boş olan yerlere getirebilirim. Şimdiden teşekkürler.

BARKOD	ALT NO	DURUM	SAYIM LİSTESİ	ALT NO	DURUM
6850310227	0	VAR	6850310227
6850310227	1	HURDA	6850310229
6850310227	2	DEPO	6850310230
6850310229	0	SATILDI
6850310229	1	HURDA
6850310230	0	YOK
6850310230	1	DEPO

 

[Korhan Ayhan]

Merhaba,

İki listenin içeriğide aynı barkod numaralarından oluştuğu için en kolay yöntem soldaki listeyi seçip kopyala-yapıştır ile sağdaki listenin üstüne yapıştırmaktır.

 

[izzetk]

Merhaba,

İki listenin içeriğide aynı barkod numaralarından oluştuğu için en kolay yöntem soldaki listeyi seçip kopyala-yapıştır ile sağdaki listenin üstüne yapıştırmaktır.

Merhaba Korhan Bey,
Öncelikle teşekkür ederim. Sorumda belirtmeyi unutmuşum, verileri alacağım liste 4.500 satırdan oluşuyor. Bu yüzden bir formüle ihtiyacım var

 

[YUSUF44]

Siz soldaki listenin aynısından mı oluşturmak istiyorsunuz yoksa başka bir amacınız mı var? İlk mesajınızdan aynısını oluşturmak istediğiniz anlaşılıyor ve Korhan Bey de buna göre cevap vermiş. Sonuçta Excel'in 10 satırı ya da 4500 satırı kopyalaması arasında fark yok. Her ikisi de aynı işlem.

Sizin asıl yapmak istediğiniz nedir? Kopyala yapıştırdan farklı olarak ne istiyorsunuz ya da başka bir deyişle kopyala yapıştır neden sizin işinize yaramıyor?

 

[izzetk]

Merhaba,
Bir dosya ekledim açıklamaları yazdım. Teşekkürler.
Saygılarımla
İzzetk

 

[YUSUF44]

Maalesef anlayamadım. Yapmak istediğiniz işlemi manuel yapıyormuş gibi adım adım anlatır mısınız?

 

[AdemCan]

Merhaba, eğer sıralama ana dosya sayfasındaki gibi sıralı ise kullanabileceğiniz kodlar.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, son1 As Long, son2 As Long
Set s1 = Sheets("ANA DOSYA"): Set s2 = Sheets("SAYIM")
son1 = s1.Cells(Rows.Count, 1).End(3).Row
son2 = s2.Cells(Rows.Count, 1).End(3).Row

With Cells
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 2 To son1
    say = WorksheetFunction.CountIf(s1.Range("A2:A" & son1), s2.Cells(i, 1))
    If say > 1 Then
        s2.Rows(i + 1 & ":" & i + say - 1).Insert Shift:=xlDown
            For r = i + 1 To i + say - 1
                s2.Cells(r, 1) = s2.Cells(i, 1)
            Next
    End If
    i = i + say - 1
Next i

For r = 2 To son1
    For c = 2 To 8
        s2.Cells(r, c) = s1.Cells(r, c)
    Next c
Next r

    With s2.Range("A1:H" & son1)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With

s2.Cells.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Spoyler: Sonuç

 

[izzetk]

Merhaba, ben anlatamadım.
Tekrar dosyaya açıklama yazdım. Teşekkür ederim.
Saygılarımla
İzzetk

 

[AdemCan]

Merhaba, formül ile satır ekleme işlemi yapılmadığı için makro ile işlemi yapmanız gerekmektedir.
İlk kod A sütununa barkod noları yazıyordu, bu paylaştığım kod ise son paylaştığınız dosyadaki gibi A sütununu boş bırakıyor.

Sub test2()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, son1 As Long, son2 As Long
Set s1 = Sheets("ANA DOSYA"): Set s2 = Sheets("SAYIM")
son1 = s1.Cells(Rows.Count, 1).End(3).Row
son2 = s2.Cells(Rows.Count, 1).End(3).Row

With Cells
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For i = 2 To son1
    say = WorksheetFunction.CountIf(s1.Range("A2:A" & son1), s2.Cells(i, 1))
    If say > 1 Then
        s2.Rows(i + 1 & ":" & i + say - 1).Insert Shift:=xlDown
    End If
    i = i + say - 1
Next i

For r = 2 To son1
    For c = 2 To 8
        s2.Cells(r, c) = s1.Cells(r, c)
    Next c
Next r

    With s2.Range("A1:H" & son1)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With

s2.Cells.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Spoyler: Sonuç

 

[izzetk]

Çok teşekkürler yardımınız için makro konusunda hiç bilgim yok yazığınız kodu nereye kopyalayacağım da yazabilir misiniz
Saygılarımla
İzzetK

 

[AdemCan]

Makro kodunu eklemek ve çalıştırmak için Sayın @Korhan Ayhan Beyin hazırlamış olduğu konulardan faydalanabilirsiniz.

Önce modül ekleyip paylaştığım kodu modüle yapıştırınız.
(Modül ekleme anlatımı https://excel.web.tr/threads/moduel-ekleme-resimli-anlatim.73353/ )

Daha sonra sayfaya buton ya da şekil ekleyip, modüle eklediğiniz kodu bu şekile atama yapıp çalıştırabilirsiniz.
( Makro atama anlatımı https://excel.web.tr/threads/sayfada-buton-duegme-olusturmak-ve-makro-atamak-2-resimli-anlatim.136979/ )

 

[izzetk]

Çok teşekkürler
Saygılarımla
İzzetK

 

[AdemCan]

Rica ederim. Saygılar.