درخواست فرمول Vlookup یا چیزی شبیه به اون در محیط ویژوال بیسیک

[Amin_D]

با سلام
من چند تا فایل اکسل دارم که تعداد رکوردهای اون زیاد هستن و میخوام یه یک سری اطلاعات رو از هر کدوم در یک فایل اکسل دیکه به صورت سطری بیارم
الان این کا رو با فرمول های اکسل انجام میدم و مشکلی نیست ولی حجم فایل خیلی بالا میره و دردسرهای خاص خودشو داره.
میخوام ببینم امکانش هست در فایلی که مد نظرم هست از فایل های دیگه با استفاده از کدهای ویژوال فراخوانی کنم
با تشکر

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[امين اسماعيلي]

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

[Amin_D]

من میخواستم نمونه فرمول Vlookup نوشتن رو تو محیط VB بدونم چطوریه؟
فرضا دو تا فایل اکسل دارم با یک آیتم ثابت چطوری میتونم بقیه اطلاعات رو فراخوانی کنم؟(برا هر کدوم از فایل ها)
با تشکر

[Amin_D]

با سلام

بر دوستان گرامی من اون مطلبی که دنبالش بودم رو با کمک استاد بزرگوار شمس العما بدست آوردم .در تاپیکی دیگه
http://forum.exceliran.com/showthrea...4892#post14892
دوستان ارجمند نحوه آدرس دهی رو توضیح دادن

من میخواستم در فایل ضمیمه "Vlookup With VB(2)"
بجای اینکه از شیت دیگه همون فایل اطلاعات رو بخونه ، بره و از فایل 2 اطلاعات رو بخونه.
با تشکر

[Amir Ghasemiyan]

با سلام

بر دوستان گرامی من اون مطلبی که دنبالش بودم رو با کمک استاد بزرگوار شمس العما بدست آوردم .در تاپیکی دیگه
http://forum.exceliran.com/showthrea...4892#post14892
دوستان ارجمند نحوه آدرس دهی رو توضیح دادن

من میخواستم در فایل ضمیمه "Vlookup With VB(2)"
بجای اینکه از شیت دیگه همون فایل اطلاعات رو بخونه ، بره و از فایل 2 اطلاعات رو بخونه.
با تشکر

سلام. همونطور كه خدمتتون عرض كرده بودم شما بايد قبل از حلقه صفحه رو عوض كنيد. با اين دستور:

Windows("book2.xlsx").Activate

[Amin_D]

سلام. همونطور كه خدمتتون عرض كرده بودم شما بايد قبل از حلقه صفحه رو عوض كنيد. با اين دستور:

Windows("book2.xlsx").Activate

بعد از این خط ، اونوقت باید آدرس فایل رو بهش بدم؟
میشه لطف کنید و دستور کامل رو بنویسید؟
با تشکر

[Amir Ghasemiyan]

بعد از این خط ، اونوقت باید آدرس فایل رو بهش بدم؟
میشه لطف کنید و دستور کامل رو بنویسید؟
با تشکر

اگه فايل هاتون باز هست اين كد رو استفاده كنيد

Private Sub CommandButton1_Click()
Dim f As Range
Dim c As Range
Dim n
Windows("book1.xlsx").Activate
For Each f In Sheet1.Range("a1:a5")
    If f.Value <> "" Then
    
    Windows("Vlookup With VB(2).xlsm").Activate
        For Each c In Sheet6.Range("a1:a5")
       
            If f.Value = c.Value Then
            n = Application.WorksheetFunction.CountA(Sheet1.Range("B1:B5"))
                Sheet1.Range("B1").Offset(n, 0).Value = c.Offset(0, 1).Value
                Sheet1.Range("B1").Offset(n, 1).Value = c.Offset(0, 2).Value
                Sheet1.Range("B1").Offset(n, 2).Value = c.Offset(0, 3).Value
                Sheet1.Range("B1").Offset(n, 3).Value = c.Offset(0, 4).Value
                Sheet1.Range("B1").Offset(n, 4).Value = c.Offset(0, 5).Value
                
            Exit For
            End If
        Next c
    End If
Next f
MsgBox "END"
End Sub

اگر باز نيست اين خط رو هم اضافه كنيد

Workbooks.Open Filename:="flie location and file name.xlsx"

[Amin_D]

اگه فايل هاتون باز هست اين كد رو استفاده كنيد

Private Sub CommandButton1_Click()
Dim f As Range
Dim c As Range
Dim n
Windows("book1.xlsx").Activate
For Each f In Sheet1.Range("a1:a5")
    If f.Value <> "" Then
    
    Windows("Vlookup With VB(2).xlsm").Activate
        For Each c In Sheet6.Range("a1:a5")
       
            If f.Value = c.Value Then
            n = Application.WorksheetFunction.CountA(Sheet1.Range("B1:B5"))
                Sheet1.Range("B1").Offset(n, 0).Value = c.Offset(0, 1).Value
                Sheet1.Range("B1").Offset(n, 1).Value = c.Offset(0, 2).Value
                Sheet1.Range("B1").Offset(n, 2).Value = c.Offset(0, 3).Value
                Sheet1.Range("B1").Offset(n, 3).Value = c.Offset(0, 4).Value
                Sheet1.Range("B1").Offset(n, 4).Value = c.Offset(0, 5).Value
                
            Exit For
            End If
        Next c
    End If
Next f
MsgBox "END"
End Sub

اگر باز نيست اين خط رو هم اضافه كنيد

Workbooks.Open Filename:="flie location and file name.xlsx"

کد خط :
Windows("book1.xlsx").Activate
چیکار میکنه؟!
من بجاش



Private Sub CommandButton1_Click()
Dim f As Range
Dim c As Range
Dim n
Windows("Vlookup With VB(1).xlsm").Activate
For Each f In Sheet1.Range("a1:a5")
If f.Value <> "" Then

Windows("Vlookup With VB(1).xlsm").Activate
For Each c In Sheet6.Range("a1:a5")

If f.Value = c.Value Then
n = Application.WorksheetFunction.CountA(Sheet1.Range( "B1:B5"))
Sheet1.Range("B1").Offset(n, 0).Value = c.Offset(0, 1).Value
Sheet1.Range("B1").Offset(n, 1).Value = c.Offset(0, 2).Value
Sheet1.Range("B1").Offset(n, 2).Value = c.Offset(0, 3).Value
Sheet1.Range("B1").Offset(n, 3).Value = c.Offset(0, 4).Value
Sheet1.Range("B1").Offset(n, 4).Value = c.Offset(0, 5).Value

Exit For
End If
Next c
End If
Next f
MsgBox "END"
End Sub

رو کد رو گذلشتم ولی باز هم جواب نداد!

[Amir Ghasemiyan]

کد خط :
Windows("book1.xlsx").Activate
چیکار میکنه؟!
من بجاش



Private Sub CommandButton1_Click()
Dim f As Range
Dim c As Range
Dim n
Windows("Vlookup With VB(1).xlsm").Activate
For Each f In Sheet1.Range("a1:a5")
If f.Value <> "" Then

Windows("Vlookup With VB(1).xlsm").Activate
For Each c In Sheet6.Range("a1:a5")

If f.Value = c.Value Then
n = Application.WorksheetFunction.CountA(Sheet1.Range( "B1:B5"))
Sheet1.Range("B1").Offset(n, 0).Value = c.Offset(0, 1).Value
Sheet1.Range("B1").Offset(n, 1).Value = c.Offset(0, 2).Value
Sheet1.Range("B1").Offset(n, 2).Value = c.Offset(0, 3).Value
Sheet1.Range("B1").Offset(n, 3).Value = c.Offset(0, 4).Value
Sheet1.Range("B1").Offset(n, 4).Value = c.Offset(0, 5).Value

Exit For
End If
Next c
End If
Next f
MsgBox "END"
End Sub

رو کد رو گذلشتم ولی باز هم جواب نداد!

شما مگه نميخواين بره از book1 اطلاعات برداره بياره تو Vlookup With VB ؟
يكي از اون خط ها كه قرمز كردم بايد book1 باشه و يكي Vlookup With VB

اون خط كارش اينه كه فايل book1 رو انتخاب ميكنه.(فايل بايد باز باشه)

[Amin_D]

خودتون تست کردین؟
جواب داد؟
من همین کدهایی که شما زحمتشو کشیدین رو برای باتوم میزام چند لحظه بعد مسیج باکس توی فایل Book 1 میده و هیچ آیتمی رکوردی رو جستجو نمیکنه