Soru Tablo verilerini süzerek yeni bir tablo oluşumunu sağlamak

[akumert]

a 2 hücresinden a80 hücresine kadar isim ve adres bilgisi var, b2 hücresinden b80 e kadar rakamlar, çekildi, katılmadı ifadeleri yer alıyor
ben bu aralıkta yer alan tablodan katılmadı yazan ifadelerin tabloya getirilmemesini istiyorum
örneğin
a2 = elif b2 = 500
a3 hasan b3 = 600
a4 mehmet b4 katılmadı
a5 hakkı b5= çekildi
a6 mesut b6 katılmadı
a7 nedim b7 10000


ben diğer tabloda sadece rakamların ve çekildi yazanların getirilmesini istiyorum yardımlarınız için şimdiden teşekkürler

 

[Cengizhantr06]

Sub FiltreleVeKopyala()
Dim ws As Worksheet
Dim srcRange As Range, destRange As Range
Dim i As Long, destRow As Long


Set ws = ThisWorkbook.Sheets(1)
Set srcRange = ws.Range("A2:B80")
Set destRange = ws.Range("D2")
destRow = destRange.Row

For i = 1 To srcRange.Rows.Count
If LCase(Trim(srcRange.Cells(i, 2).Value)) <> "katılmadı" Then

ws.Cells(destRow, destRange.Column).Value = srcRange.Cells(i, 1).Value ' İsim
ws.Cells(destRow, destRange.Column + 1).Value = srcRange.Cells(i, 2).Value ' Rakam/Çekildi
destRow = destRow + 1
End If
Next i

MsgBox "Katılmadı olanlar hariç tablo kopyalandı!", vbInformation
End Sub

 

[akumert]

Sub FiltreleVeKopyala()
Dim ws As Worksheet
Dim srcRange As Range, destRange As Range
Dim i As Long, destRow As Long


Set ws = ThisWorkbook.Sheets(1)
Set srcRange = ws.Range("A2:B80")
Set destRange = ws.Range("D2")
destRow = destRange.Row

For i = 1 To srcRange.Rows.Count
If LCase(Trim(srcRange.Cells(i, 2).Value)) <> "katılmadı" Then

ws.Cells(destRow, destRange.Column).Value = srcRange.Cells(i, 1).Value ' İsim
ws.Cells(destRow, destRange.Column + 1).Value = srcRange.Cells(i, 2).Value ' Rakam/Çekildi
destRow = destRow + 1
End If
Next i

MsgBox "Katılmadı olanlar hariç tablo kopyalandı!", vbInformation
End Sub

kod haricinde formülle yapma imkanı var mıdır

 

[Cengizhantr06]

=FİLTRE(A2:B80;B2:B80<>"Katılmadı";"")

 

[akumert]

Sub FiltreleVeKopyala()
Dim ws As Worksheet
Dim srcRange As Range, destRange As Range
Dim i As Long, destRow As Long


Set ws = ThisWorkbook.Sheets(1)
Set srcRange = ws.Range("A2:B80")
Set destRange = ws.Range("D2")
destRow = destRange.Row

For i = 1 To srcRange.Rows.Count
If LCase(Trim(srcRange.Cells(i, 2).Value)) <> "katılmadı" Then

ws.Cells(destRow, destRange.Column).Value = srcRange.Cells(i, 1).Value ' İsim
ws.Cells(destRow, destRange.Column + 1).Value = srcRange.Cells(i, 2).Value ' Rakam/Çekildi
destRow = destRow + 1
End If
Next i

MsgBox "Katılmadı olanlar hariç tablo kopyalandı!", vbInformation
End Sub

Bu sayfada aşağıdaki şekilde çalışan bir kod var sizin verdiğiniz kodla aynı anda çalışma imkanı olabilir mi


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long
Dim Satir As Range
Dim BosHücre As Boolean

' Yalnızca "1 İhale Kararı" sayfasında çalış
Set ws = Me

' Sadece A110:AL184 aralığını kontrol et
If Not Intersect(Target, ws.Range("A110:AL184")) Is Nothing Then
Application.EnableEvents = False ' Döngüleri önlemek için etkinlikleri devre dışı bırak

For i = 110 To 184
BosHücre = False
Set Satir = ws.Rows(i).Columns("A:AL")

' Satırda boş hücre var mı kontrol et
If Application.WorksheetFunction.CountBlank(Satir) = Satir.Columns.Count Then
BosHücre = True
End If

' Eğer satırda boş hücre varsa gizle; doluysa göster
If BosHücre Then
ws.Rows(i).EntireRow.Hidden = True
Else
ws.Rows(i).EntireRow.Hidden = False
End If
Next i

Application.EnableEvents = True ' Etkinlikleri tekrar etkinleştir
End If
End Sub

 

[Cengizhantr06]

Şuan PC başında değilim malesef

 

[volki_112]

@akumert excel versiyonunuz nedir

 

[akumert]

@akumert excel versiyonunuz nedir

microsoft office professional plus 2016

 

[volki_112]

microsoft office professional plus 2016

istediğin veriler nereye yazılacak yeni bir sayfaya mı listelensin

 

[akumert]

istediğin veriler nereye yazılacak yeni bir sayfaya mı listelensin

B 109 İLE C169 aralığına yani b sütununda adı soyadı şekilnde c sütununda da rakamlar ve çekildi ifadeleri olması yeterli

 

[volki_112]

B 109 İLE C169 aralığına yani b sütununda adı soyadı şekilnde c sütununda da rakamlar ve çekildi ifadeleri olması yeterli

istediğin çözüm. Yeni bir A sütunu yapıp yardımcı sütun olarak kullandım. Bilginiz olsunn. O sütunu gizleyebilirsiniz.

 

[akumert]

istediğin çözüm. Yeni bir A sütunu yapıp yardımcı sütun olarak kullandım. Bilginiz olsunn. O sütunu gizleyebilirsiniz.

BİLGİSAYARDA AÇINCA HATA VERDİ