نحوه انتخاب یک سلول با مقدار یکسان با vba

[alper]

سلام دوستان

من یک شیت دارم که داخلش کد های پرسنلی ذخیره شده - در همون شیت میخوام با ماکرو نویسی بگم هر سلولی که مقدارش با سلول N1 یکی هست رو Select و کپی کن - با توجه به اینکه شاید یک کد پرسنلی بصورت پراکنده در ردیف های مختلف تکرار شده باشه.

[rasools13]

سلام از کد ذیل میتونید استفاده کنید..
فایل نمونه هم پیوست شده است
موفق باشید

Sub MultiSelection()
'    
Dim i, col, row, Total_row, MyCode As Integer    
Dim cel As String   
     
col = 4                          'شماره ستون مورد جست و جو    
row = 4                         ' شماره ردیفی از ستون مورد جست و جو که میخواهید جست و جو از ان ردیف شروع شود    
Total_row = row + 9     'بجای عدد تعداد ردیف هایی که میخواهید بررسی شود را وارد کنید    
MyCode = 1                  ' مقداری که میخواهید جست و جو کنید همان کدپرسنلی
 '    
With Application.WorksheetFunction        
         For i = row To Total_row Step 1            
                 If Cells(i, col) = MyCode Then                
                       cel = cel + .Substitute(Cells(i, col).Address, "$", "") + ","            
                 End If
       Next i
       '
       cel = Mid(cel, 1, Len(cel) - 1)
   End With
   Range(cel).Select
   Selection.Copy
'
End Sub 

[مرتضی حسینی]

چرا از conditional formating استفاده نمی کنید خیلی راحتره فایل \یوست و مشاهده کنید
97/4/3

[alper]

سلام از کد ذیل میتونید استفاده کنید..
فایل نمونه هم پیوست شده است
موفق باشید

sub multiselection()
'    
dim i, col, row, total_row, mycode as integer    
dim cel as string   
     
col = 4                          'شماره ستون مورد جست و جو    
row = 4                         ' شماره ردیفی از ستون مورد جست و جو که میخواهید جست و جو از ان ردیف شروع شود    
total_row = row + 9     'بجای عدد تعداد ردیف هایی که میخواهید بررسی شود را وارد کنید    
mycode = 1                  ' مقداری که میخواهید جست و جو کنید همان کدپرسنلی
 '    
with application.worksheetfunction        
         for i = row to total_row step 1            
                 if cells(i, col) = mycode then                
                       cel = cel + .substitute(cells(i, col).address, "$", "") + ","            
                 end if
       next i
       '
       cel = mid(cel, 1, len(cel) - 1)
   end with
   range(cel).select
   selection.copy
'
end sub 

ممنونم از شما - دقیقا همینو میخواستم
یه سوال اینجا که فقط یک سلول رو انتخاب میکنه - میشه گقت هر جایی که با کد من برابر هست اون سطر ها مثلا ( a:c ) کپی کنه؟

یه سوال دیگه:

آیا تووی شیتی که مثلاً یک کد پرسنلی فیلتر شده - میشه گفت حالا 25 ردیف اول رو میبینی ( فیلتر شده ) کپی کنه بدون اینکه سلول های فیلتر شده رو کپی نکنه

ممنون میشم پاسخ بدید

[rasools13]

ممنونم از شما - دقیقا همینو میخواستم
یه سوال اینجا که فقط یک سلول رو انتخاب میکنه - میشه گقت هر جایی که با کد من برابر هست اون سطر ها مثلا ( a:c ) کپی کنه؟

یه سوال دیگه:

آیا تووی شیتی که مثلاً یک کد پرسنلی فیلتر شده - میشه گفت حالا 25 ردیف اول رو میبینی ( فیلتر شده ) کپی کنه بدون اینکه سلول های فیلتر شده رو کپی نکنه

ممنون میشم پاسخ بدید

در مورد سوال اول اینکه هر سلول مساوی مقدار مورد نظر روانتخاب و کپی می کنه... فایل \یوست رو ببینید
در مورد سوال دوم هم فایل نمونه بزارید

[alper]

در مورد سوال اول اینکه هر سلول مساوی مقدار مورد نظر روانتخاب و کپی می کنه... فایل \یوست رو ببینید
در مورد سوال دوم هم فایل نمونه بزارید

ببنید تووی فایلی که ضمیمه کردم - 2 تا ستون دارم ( ردیف - نام )

1 - اونائی که ردیف 1 هست فیلتر میکنم -
2 - بعد با استفاده از برنامه نویسی ماکرو - میخوام 10 ردیف اولی که بعد از فیلتر نشون میده رو کپی کنه ( بدون اینکه ردیف های مخفی شده رو کپی کنه )

----
توضیح :
میدونم که میتونم بعد از فیلتر شدن کل سلول ها رو کپی کنم تووی یک شیت دیگه اون موقع فقط فیلتر شده ها رو کپی میکنه - ولی یه ایرادی که داره اینه که تووی شیت مقصد بیش از 100000 رکورد خالی هم ایجاد میکنه موقع پیست کردن.

[rasools13]

ببنید تووی فایلی که ضمیمه کردم - 2 تا ستون دارم ( ردیف - نام )

1 - اونائی که ردیف 1 هست فیلتر میکنم -
2 - بعد با استفاده از برنامه نویسی ماکرو - میخوام 10 ردیف اولی که بعد از فیلتر نشون میده رو کپی کنه ( بدون اینکه ردیف های مخفی شده رو کپی کنه )

----
توضیح :
میدونم که میتونم بعد از فیلتر شدن کل سلول ها رو کپی کنم تووی یک شیت دیگه اون موقع فقط فیلتر شده ها رو کپی میکنه - ولی یه ایرادی که داره اینه که تووی شیت مقصد بیش از 100000 رکورد خالی هم ایجاد میکنه موقع پیست کردن.

سلام مجدد
اگر میخواهید داده های مربوط به یک شماره مشخص را در جای دیگر کپی کنید نیازی به فیلتر کردن و ... نیست... با استفاده از کد ذیل می توانید این کار را انجام دهید

Sub Copy_1()
Dim row, i, MyNum, j As Integer
Range("H:H").Clear
j = 1
MyNum = Range("G1")
row = Application.WorksheetFunction.CountA(Range("A:A")) - 1
    For i = 2 To row Step 1
        If Cells(i, 1) = MyNum Then
            Cells(j, 8) = Cells(i, 2)
            j = j + 1
        End If 
   Next i
End Sub 

با توجه به فایل نمونه ای که فرستادید شماره ردیف مورد نظر را در سلول G1 وارد کرده و این کد را اجرا کنید... مقادیر موجود در ستون دوم (نام) که دارای شماره مورد نظر هستند در ستون H کپی می شوند.. بدون فاصله بین مقادیر
...
فایل نمونه هم پیوست شده است