(04/11/2020, 12:52)feraz yazdı: Örnek dosyanızda sütundakiler demiştiniz.İf koşulu ekledim dizi olarak.ÇOOKKK TEŞEKKÜR EDERİM....
ilk koduda ayarlarım.Hata olursa koddaki Tr karakterlerini düzeltin.
Buda ilk kodun düzenlenmiş hali.Sub Aktar()
Dim syfForum As Worksheet, arr(), veri(), say As Long
Dim i As Long, son As Long, sonVer As Long
Set syfForum = ThisWorkbook.Sheets("Form")
say = 0
With ThisWorkbook.Sheets("Veri")
syfForum.Range("A2:F" & Rows.Count).ClearContents
son = .Cells(Rows.Count, "M").End(3).Row
If son < 2 Then son = 2
If WorksheetFunction.CountA(.Range("M2:M" & Rows.Count)) = 0 Then GoTo son
Application.ScreenUpdating = False
veri = .Range("A2:S" & son).Value
ReDim arr(1 To son, 1 To 19)
For i = LBound(veri) To UBound(veri)
If LCase(CStr(veri(i, 13))) = "yabancı araç plakasına" Then
say = say + 1
arr(say, 1) = veri(i, 6)
arr(say, 2) = Format(veri(i, 19), "dd.mm.yyyy") & " " & Format(CStr(veri(i, 7)), "hh:mm")
arr(say, 3) = veri(i, 2) & "-" & veri(i, 3)
arr(say, 4) = veri(i, 12)
arr(say, 5) = veri(i, 4)
End If
Next
Application.ScreenUpdating = True
If say > 0 Then
syfForum.Range("A2").Resize(say, 5).Value = arr
MsgBox "Akrarma Tamam...", vbInformation, "Aktarma"
End If
End With
GoTo son2
son:
MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma"
son2:
Set syfForum = Nothing: Erase arr: Erase veri
End Sub
Sub Aktar2()
Dim syfForum As Worksheet, say As Long
Dim i As Long, son As Long
Set syfForum = ThisWorkbook.Sheets("Form")
say = 2
syfForum.Range("A2:F" & Rows.Count).ClearContents
With ThisWorkbook.Sheets("Veri")
son = .Cells(Rows.Count, "M").End(3).Row
If son < 2 Then son = 2
If WorksheetFunction.CountA(.Range("M2:M" & Rows.Count)) = 0 Then GoTo son
Application.ScreenUpdating = False
For i = 2 To son
If LCase(.Cells(i, "M").Value) = "yabancý araç plakasýna" Then
syfForum.Cells(say, 1).Value = .Cells(i, "F").Value
syfForum.Cells(say, 2).Value = .Cells(i, "S").Value & " " & .Cells(i, "G").Value
syfForum.Cells(say, 3).Value = .Cells(i, "B").Value & "-" & .Cells(i, "C").Value
syfForum.Cells(say, 4).Value = .Cells(i, "L").Value
syfForum.Cells(say, 5).Value = .Cells(i, "D").Value
say = say + 1
End If
Next
If say > 2 Then
MsgBox "Akrarma Tamam...", vbInformation, "Aktarma"
Else
MsgBox "Akrarilacak veri bulunamadi...", vbExclamation, "Aktarma"
End If
Application.ScreenUpdating = True
End With
GoTo son2
son:
MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma"
son2:
Set syfForum = Nothing
End Sub
Veri Aktarma
Bu Konudaki Yorumlar |
Veri Aktarma - Yazar: HORZUM - 04/11/2020, 09:25
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 09:38
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 12:27
RE: Veri Aktarma - Yazar: HORZUM - 04/11/2020, 12:45
Re: Veri Aktarma - Yazar: feraz - 04/11/2020, 12:52
RE: Veri Aktarma - Yazar: HORZUM - 04/11/2020, 13:56
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 14:18
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 16:24
RE: Veri Aktarma - Yazar: HORZUM - 04/11/2020, 17:02
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 16:39
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 16:42
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 16:52
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 17:06
RE: Veri Aktarma - Yazar: HORZUM - 04/11/2020, 17:08
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 17:21
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 22:35
RE: Veri Aktarma - Yazar: HORZUM - 04/11/2020, 17:22
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 17:34
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 17:42
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 22:49
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 23:01
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 23:05
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 23:09
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 23:13
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 23:30
RE: Veri Aktarma - Yazar: berduş - 04/11/2020, 23:42
RE: Veri Aktarma - Yazar: feraz - 04/11/2020, 23:53
RE: Veri Aktarma - Yazar: berduş - 05/11/2020, 08:22
RE: Veri Aktarma - Yazar: HORZUM - 05/11/2020, 09:29
RE: Veri Aktarma - Yazar: berduş - 05/11/2020, 10:58
RE: Veri Aktarma - Yazar: HORZUM - 05/11/2020, 17:05
RE: Veri Aktarma - Yazar: feraz - 05/11/2020, 12:53
RE: Veri Aktarma - Yazar: berduş - 05/11/2020, 13:23
RE: Veri Aktarma - Yazar: feraz - 05/11/2020, 15:45
RE: Veri Aktarma - Yazar: berduş - 05/11/2020, 15:49
RE: Veri Aktarma - Yazar: feraz - 05/11/2020, 17:21
|
Konuyu Okuyanlar: 2 Ziyaretçi