• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile ilgili bir soru?

Katılım
8 Mart 2009
Mesajlar
504
Excel Vers. ve Dili
2010
Ekteki dosyada bulunan sütundaki rakamları diğer sayfaya aktarmasını istiyorum ama bir türlü olmuyor yardımcı olurmusunuz.
 

Ekli dosyalar

Kodunuzu şu şekilde değiştiriniz.

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range
    Dim sAdr As String
    Dim iStr As Integer
    Dim y As Integer
    
    If Target.Address = Range("H1").Address Then
        
        Set rng = Columns(2).Find(Target, lookat:=xlWhole)
        If Not rng Is Nothing Then
    
            Sheets("Rapor1").Rows("2:" & Sheets("Rapor1").Cells(65536, 1).End(xlUp).Row).ClearContents
        
            sAdr = rng.Address: iStr = rng.Row
            y = 2
        
            Do
                Range("A" & iStr & ":D" & iStr).Copy Sheets("Rapor1").Range("A" & y & ":D" & y)
            
                Set rng = Columns(2).FindNext(rng)
        
                y = y + 1: iStr = rng.Row
        
            Loop Until rng Is Nothing Or sAdr = rng.Address
            
            Sheets("Rapor1").Select
                    
        Else
            MsgBox "Hiçbir eşleşme sağlanmadı", vbCritical, "Uyarı"
        End If
    
    End If
        
    Set rng = Nothing
End Sub

...
 
dosyadaki diğer makrolar çalışmıyor sadece rakamların olduğu makro çalışıyor, sizinkinde
 
Son düzenleme:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet
If Intersect(Target, Range("I1:J1,K1")) Is Nothing Then Exit Sub
Cancel = True
If Target.Address = "$I$1" Then
alan = 3
Set sh = Sheets("RAPOR")
ElseIf Target.Address = "$J$1" Then
alan = 8

Set sh = Sheets("RAPOR1")

Else
alan = 6
Set sh = Sheets("RAPOR2")
End If

If Target <> "" Then
sh.Columns("A:H").ClearContents
Range("A1").AutoFilter Field:=alan, Criteria1:="=*" & Target & "*"
Range("A1").CurrentRegion.Copy sh.Range("A1")
Range("A1").AutoFilter
sh.Select
sh.Cells.EntireColumn.AutoFit
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End If
Set sh = Nothing
End Su



Bu makrolar düzgün çalışıyor sadece kırmızı olan yerde normal rakam aratmak ve (rapor1 ) sayfasına yazdırması nı sağlamak istiyorum.
 
Dosyanızın içindeki açıklama şöyleydi...

H1 hücresini çift tıkladığımda b sütunundakki 231 olanları RAPOR1 sayfasına yazdırmasını istiyorum, ancak B sütunundaki rakamların biçimlendirmeleri Genel veyahut sayı olduğunda bulamıyor, sadece biçimi metin şeklinde oldumu buluyor, makroda nasıl bir düzeltme yapabiliriz.

Tabi hal böyleyken, insan ister istemez sadece buna odaklanıyor:) Önceki kodların çalışmadığını düşünerek (hiç bakmadan), yenisini yazıp geçmişim...

Son gönderdiğiniz mesajda H1 hücresinden bahsetmemektesiniz.

Dikkat ederseniz, siz AutoFilter özelliğini kullanmaktasınız ve bazı sorunlar yaşamaktasınız. Ben ise farklı bir yöntem kullanmışım.

Sorun şu ki, ben sizin orjinal kodlarınızın ne yaptığını çözemedim... Ne yapmak istediğinizi ve yapıyı biraz açıklarsanız , daha iyi olur...

...
 
yapmak istediğim ekteki dosyada,J1 hücresine yazdığım rakamı (D) sütununda arayıp bulmasını ve bunların geçtiği satırların tamamını (rapor1) sayfasına yazdırmasını istiyorum, I,J,K 1 hücrelerine yazdıklarımı bulup ilgili sayfalara normal olarak yazıyor sadece rakam olarak aratıp yazdıramıyorum. yardımcı olursanız seviniriz.
 

Ekli dosyalar

Son düzenleme:
acil yardım!!!

VBA kitaplıkları (40040)sıfırlanırken bir hata oluştu "mesajı geliyor ,makrom çalışmıyo ne yapmalıyım???
 
İşinize yaradığına sevindim. Size de kolay gelsin.
 
Geri
Üst