PDA

توجه ! این یک نسخه آرشیو شده میباشد و در این حالت شما عکسی را مشاهده نمیکنید برای مشاهده کامل متن و عکسها بر روی لینک مقابل کلیک کنید : سوال پیرامون هایپر لینک



علی فاطمی
2015/11/14, 07:30
با سلام خدمت اسایتد و کاربران محترم

در Book1 از سلول A1 تا A10 به ترتیب حروف a تا J قرار داده شده و تمامی این سلول ها به Book2 شیت 1 و سلول A1 هایپر لینک شده اند.
حال آیا این امکان وجود دارد زمانی که بر روی هر یک از این سلول ها کلیک شد ، ضمن باز شدن Book2 مجتویات همان سلول را در Book2 شیت 1 و سلول A1 کپی شود یعنی اگر A1 کلیک شد حرف a و اگر A10 کلیک شد حرف J در Book2 شیت 1 و سلول A1 کپی شود .

ممنون از توجه عزیزان

علی فاطمی
2015/11/14, 09:16
:min4:

علی فاطمی
2015/11/14, 11:02
:min7:

iranweld
2015/11/14, 11:31
با سلام

دو فایل پیوست را در یک مسیر کپی نمایید و book1.xlsx را اجرا نمایید

از قابلیت Event در تهیه فایل استفاده گردید


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("A1:A10")) Is Nothing Then

If Range("B1").Value = "yes" Then

TEST1

Else

End If
End If

End Sub

ماکرویی که فراخوانی میگردد


Public x As Variant

Sub TEST1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

x = ActiveCell.Value

Workbooks.Open fileName:=directory & "BOOK2.XLSX"

Sheets(1).Select

Range("A1").Select

Range("A1").Value = x



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

علی فاطمی
2015/11/18, 13:44
با سلام

دو فایل پیوست را در یک مسیر کپی نمایید و book1.xlsx را اجرا نمایید

از قابلیت Event در تهیه فایل استفاده گردید


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("A1:A10")) Is Nothing Then

If Range("B1").Value = "yes" Then

TEST1

Else

End If
End If

End Sub

ماکرویی که فراخوانی میگردد


Public x As Variant

Sub TEST1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

x = ActiveCell.Value

Workbooks.Open fileName:=directory & "BOOK2.XLSX"

Sheets(1).Select

Range("A1").Select

Range("A1").Value = x



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub



با سلام و تشکر از دوست عزیز iranweld
لطفا فایل زیپ پیوست رو باز بفرمایید در فایل word توضیحاتی داده شده است.
ممنون از توجه شما.

iranweld
2015/11/18, 15:01
با سلام

در ماکرو فایل دوم چند سطر اول را بصورت ذیل تغییر بدید. در حالت فعلی ماکرو شما کل 100000 سلول ستون A را چک مینماید ولی با تغییر به شکل ذیل فقط چند ردیف سلول پر ستون A چک میگردد


Sub Resid()

Dim a

Dim zz As Range

k = Cells(Rows.Count, "A").End(xlUp).Row

For Each zz In Sheet3.Range("a4:a" & k)

If Sheet2.Range("a1") = zz Then