auto filter در vba

[esyoo]

سلام
sheet1 حاوی اطلاعات زیر هست.(در واقع دیتا بیس)
قصدم اینکه در یوزر فرم هر کس کد ماشین و ماه رو که زد بیاد اطلاعات مربوط به اون ماشین و اون ماه رو در sheet2 قرار بده.
از چه فرمولی استفاده کنم؟
ممنون میشم راهنمایی بکنید.

http://aks98.com/images/8c9mva9hpf87m5qj0v0.jpg

http://aks98.com/images/a2uw0hasqrjvc9jacnjn.jpg

فایل مورد نظر:
http://www.4shared.com/file/_bLIV-SM/auto_filter_esyoo.html

[khakzad]

سلام
حتما باید از طریق Vba انجام بشه؟
چون به راحتی میتونید از فرمول vlookup استفاده کنید.
به این صورت که با if شماره گذاری کنید ماشین 1000 رو در ماه 1 و بعد اون اعداد رو vlookup کنید!!!

[esyoo]

بله دوست عزیز
اتفاقا همین کاری رو که شما میگید رو کردم.
ولی اطلاعاتم به بالای 30000 رکورد میرسه و حجم فایل و محاسبات فوق العاده بالا میره

من با ضبط ماکرو از فیلتر هم نتونستم کاری بکنم.مشکلم در تعریف این دو سلول زیر بود.
Columns("A:D").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=1, Criteria1:="g1", _
Operator:=xlAnd
ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=2, Criteria1:="h1", _
Operator:=xlAnd
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
End Sub

[esyoo]

مشکل رو حل کردم. به این شکل:
Columns("A:D").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=1, Criteria1:=Range("g1"), _
Operator:=xlAnd
ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=2, Criteria1:=Range("h1"), _
Operator:=xlAnd
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
End Sub[hr]
حالا مشکل بعدی رو میگم!
همان طور که توی عکس پست اول می بینید
تاریخ 88/01/01در sheet1 تبدیل شده به ماه 1 در sheet2
این رو با vba چطور انجام بدم؟
اصلا این کار خوبی هست؟

من یک گزارش ماهانه می خوام.ولی ممکنه بعضی وقت ها یک بازه زمانی هم به من داده بشه مثلا از88/01/25 تا 88/02/19

ممنون میشم در این مورد من رو راهنمایی بفرمایید.

[amator]

میشه لطفاً نمونه فایل رو هم ضمیمه کنین

[esyoo]

سلام
دوست عزیز نمونه فایل در پست اول موجود هست.

خوب این قسمت رو هم فهمیدم.
ولی مشکلم اینکه اگر رنج b1 تا b1000 روبه عنوان تاریخ در نظر بگیرید و رنج e1 تا e1000 رو به عنوان ماه در نظر بگیرید. اون وقت باید کد زیر درست عمل بکنه که نمیکنه!
For i = 1 To 1000
Range("sheet1.cells(i,5)") = Mid(Range("sheet1.cells(i,2)"), 4, 2)
Next

[shamsololama]

سلام
دوست عزیز نمونه فایل در پست اول موجود هست.

خوب این قسمت رو هم فهمیدم.
ولی مشکلم اینکه اگر رنج b1 تا b1000 روبه عنوان تاریخ در نظر بگیرید و رنج e1 تا e1000 رو به عنوان ماه در نظر بگیرید. اون وقت باید کد زیر درست عمل بکنه که نمیکنه!
For i = 1 To 1000
Range("sheet1.cells(i,5)") = Mid(Range("sheet1.cells(i,2)"), 4, 2)
Next


کدی که نوشتین range رو از کد حذف کن بصورت زیر تا اجرا بشه

Sheet1.Cells(i, 5) = Mid(Sheet1.Cells(i, 2), 4, 2)[hr]
با درود فراوان

برای استفاده در یوزرفورم بالا که مثال زده بودی می توانی برای یافتن موارد مورد نظر و انتقال آنها به شیت 2 از کد زیر استفاده کنی که برای استفاده برابر با نیاز خود می توانی آن را تغییر دهی
و با ایم فرض نوشتم که Textbox1 و Textbox2 را در یوزرفرم دارید

Private Sub CommandButton1_Click()

With Sheet1.Range("a1:a4000")
Set c = .Find(TextBox1.Text, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do

If Mid(c.Offset(0, 1), 4, 2) = TextBox2.Text Then

n = n + 1
Sheet2.Range("A1").Offset(n, 0).Value = c
Sheet2.Range("A1").Offset(n, 1).Value = TextBox2.Text
Sheet2.Range("A1").Offset(n, 2).Value = c.Offset(0, 2).Value
Sheet2.Range("A1").Offset(n, 3).Value = c.Offset(0, 3).Value
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

End With

End Sub

[esyoo]

با سلام
این خط کد نمی دونم چرا نتیجه محاسبات رو در سلول های مورد نظر اعمال نمی کنه!
Sheet1.Cells(i, 5) = Mid(Sheet1.Cells(i, 2), 4, 2)[hr]
مشکل حل شد.
Private Sub CommandButton1_Click()
For i = 1 To 1000
If Mid(Cells(i, 1), 4, 1) = "0" Then
Cells(i, 2) = Mid(Cells(i, 1), 5, 1)
ElseIf Mid(Cells(i, 1), 4, 1) = "1" Then
Cells(i, 2) = Mid(Cells(i, 1), 4, 2)
End If
Next
End Sub

[amator]

سلام eysoo عزیز
قصد یادگیریه دیگه
اگه با تغییراتی که در کدها میدین لطف کنین فایلها رو هم ضمیمه کنین آماتورهایی مثل من هم متوجه میشن دارین چیکار میکنین و این کدها رو کجا باید گذاشت.
مرسی

[esyoo]

سلام
من خودم هنوز آماتور آماتور(2 تا آماتور) هستم! شکسته بندی نفرمایید.
خدمت شما.
http://www.4shared.com/file/cGowQHwv/mid.html