VBA Birleştirme

[horzum]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bul As Range
Dim trh As Date
Dim CsutunTarih As Date
Dim blg As Range

With ThisWorkbook.Sheets("T1")
If (Target.Column = 3 Or Target.Column = 5) And Target.Row >= 1 Then
If IsDate(Cells(Target.Row, "c")) And Len(Cells(Target.Row, "E") & "") > 0 Then
SonStn = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)
Set kaydir = .Range("A:A").Find(Cells(Target.Row, "E").Value, , , 1)
If (Not bul Is Nothing) And (Not kaydir Is Nothing) Then Cells(Target.Row, "F").Value = .Cells(kaydir.Row, bul.Column).Value
End If
End If
End With
Set bul = Nothing

Exit Sub

On Error Resume Next

If Target.Count > 1 Then Exit Sub

Set blg = Range("c:c")

If Intersect(Target, blg) Is Nothing Then Exit Sub

If Len(Target) = 8 Then
If InStr(Target, ".") = 0 Then Target = Format(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 4), "dd/mm/yyyy;@")
ElseIf Len(Target) = 7 Then
If InStr(Target, ".") = 0 Then Target = Format(Left(Target, 1) & "." & Mid(Target, 2, 2) & "." & Right(Target, 4), "dd/mm/yyyy;@")
End If
End Sub

KODUNU ÇALIŞTIRAMIYORUM

 

[Muzaffer Ali]

Merhaba.
Tam olarak ne yapmak istediğinizi söylerseniz yeniden kod yazmak daha kolay olacaktır.
Ayrıca örnek bir dosya eklemelisiniz.
Örnek dosyanızı dosya.co gibi bir paylaşım sitesine ekleyebilirsiniz.

 

[horzum]

Merhaba.
Tam olarak ne yapmak istediğinizi söylerseniz yeniden kod yazmak daha kolay olacaktır.
Ayrıca örnek bir dosya eklemelisiniz.
Örnek dosyanızı dosya.co gibi bir paylaşım sitesine ekleyebilirsiniz.

İlgin için teşekkür ederim.

İndir Aralık xlsm

Dosyayı indir Aralık xlsm

dosya.co

linkine yükledim.

 

[Muzaffer Ali]

Eski kodu silip yerine aşağıdaki kodu kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Satir As Long
    Dim Sutun As Integer
    
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Not IsDate(Cells(Target.Row, "C")) Then
            MsgBox "Lütfen önce 'FATURA TARİHİ' kısmına geçerli bir tarih giriniz.", vbExclamation
            Exit Sub
        End If
        With Worksheets("T1")
            Satir = .Range("A:A").Find(Target, lookat:=xlWhole).Row
            Sutun = .Rows("1:1").Find(Year(Cells(Target.Row, "C")), lookat:=xlWhole).Column
            
            Cells(Target.Row, "F") = .Cells(Satir, Sutun)
        End With
    ElseIf Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Len(Target) = 8 Then
            If InStr(Target, ".") = 0 Then Target = FormatDateTime(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 4), vbShortDate)
        ElseIf Len(Target) = 7 Then
            If InStr(Target, ".") = 0 Then Target = FormatDateTime(Left(Target, 1) & "." & Mid(Target, 2, 2) & "." & Right(Target, 4), vbShortDate)
        End If
    End If
End Sub

 

[horzum]

Eski kodu silip yerine aşağıdaki kodu kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Satir As Long
    Dim Sutun As Integer
  
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Not IsDate(Cells(Target.Row, "C")) Then
            MsgBox "Lütfen önce 'FATURA TARİHİ' kısmına geçerli bir tarih giriniz.", vbExclamation
            Exit Sub
        End If
        With Worksheets("T1")
            Satir = .Range("A:A").Find(Target, lookat:=xlWhole).Row
            Sutun = .Rows("1:1").Find(Year(Cells(Target.Row, "C")), lookat:=xlWhole).Column
          
            Cells(Target.Row, "F") = .Cells(Satir, Sutun)
        End With
    ElseIf Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Len(Target) = 8 Then
            If InStr(Target, ".") = 0 Then Target = FormatDateTime(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 4), vbShortDate)
        ElseIf Len(Target) = 7 Then
            If InStr(Target, ".") = 0 Then Target = FormatDateTime(Left(Target, 1) & "." & Mid(Target, 2, 2) & "." & Right(Target, 4), vbShortDate)
        End If
    End If
End Sub

Tarih kısmına 02022024 şeklinde yazınca tarih 10.02.7436 oluyor. yoğun giriş yapıldığı için tarih arasına nokta v.b koymak zaman alıyor. Ayrıca 11122024 şeklince yazınca da hata veriyor

 

[Muzaffer Ali]

C sütunun hücre formatını Sayı yada Genel yaparsanız hata vermez.

İndir Aralık xlsm

Dosyayı indir Aralık xlsm

dosya.co

 

[horzum]

C sütunun hücre formatını Sayı yada Genel yaparsanız hata vermez.

İndir Aralık xlsm

Dosyayı indir Aralık xlsm

dosya.co

ilginiz ve alakanız için teşekkür ederim. Kalın sağlıcakla.....