
تداعی کامیاب
8 ماه پیش
حل شده
پاسخ
ثبت اطلاعات در شیت مقصد بر اساس شروط تعیین شده
سلام و وقت بخیر
بر اساس دو شرط در دو سلول اطلاعات product1 و farm 1 میخوام در ردیف زوج در شیت مقصد و در صورتی که product 2 و farm 2 باشه در ردیف خالی فرد شیت مقصد درج بشه
این فرمول در قسمت دوم عمل نمیکنه
ممنون میشم راهنمایی بفرمایین
Option Explicit
Sub Button_Click()
Dim source As Worksheet
Dim destination As Worksheet
Dim a As Integer
Dim j As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Sheet2.Cells(2, 1) = "product1" And Sheet2.Range("a1") = "farm1" Then
Set source = Worksheets("sheet2")
Set destination = Worksheets("sheet4")
a = 1
Do Until Sheet4.Cells(a, 2) = "" And a Mod 2 <> 0
a = a + 1
Loop
For j = 2 To 91
Sheet4.Cells(a, j) = Sheet2.Cells(2, j)
Next j
ElseIf Sheet2.Cells(2, 1) = "product2" And Sheet2.Range("a1") = "farm1" Then
Set source = Worksheets("sheet2")
Set destination = Worksheets("sheet4")
Do Until Sheet4.Cells(a, 2) = "" And a Mod 2 = 0
a = a + 1
Loop
For j = 2 To 91
Sheet4.Cells(a, j) = Sheet2.Cells(2, j)
Next j
End If
If Sheet2.Cells(2, 1) = "product1" And Sheet2.Range("a1") = "farm2" Then
Set source = Worksheets("sheet2")
Set destination = Worksheets("sheet1")
a = 1
Do Until Sheet1.Cells(a, 2) = "" And a Mod 2 <> 0
a = a + 1
Loop
For j = 2 To 91
Sheet1.Cells(a, j) = Sheet2.Cells(2, j)
Next j
ElseIf Sheet2.Cells(2, 1) = "product2" And Sheet2.Range("a1") = "farm2" Then
Set source = Worksheets("sheet2")
Set destination = Worksheets("sheet1")
Do Until Sheet1.Cells(a, 2) = "" And a Mod 2 = 0
a = a + 1
Loop
For j = 2 To 91
Sheet1.Cells(a, j) = Sheet2.Cells(2, j)
Next j
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
گزارش تخلف
سؤالات مربوط به VBA در اکسل
برو به
به پشتیبانی نیاز داری؟
در صورتی که
- در کار با بتازون مشکلی دارید
- در مورد خدمات بتازون سؤالی دارید
- نظراتی را برای ارتقا و بهبود خدمات دارید
خوشحال میشیم که حتماً با ما در میان بزارید

علی محمد یاوری
8 ماه پیش
پاسخ حل کننده
سلام، در قدم اول ممنون میشیم در سوالات بعدی از دکمه </> برای قرار دادن کد ها استفاده کنید تا همه بهتر بتونیم کد رو مثل زیر بخونیم.
و اما پاسخ:
فکر کنم مشکل اصلی شما پیدا کردن اولین ردیف خالی زوج و فرد هست. بیایید با یک تیر 2 نشان بزنیم.
چون شما برای اینکار از حلقه Do استفاده کردید و این یعنی داده زیاد بشه، سرعت برنامه بی نهایت کم میشه.
و اما کد حل مشکل:
first_break = Cells(1, 1).End(xlDown).Row
last_row = Cells(Rows.Count, 1).End(xlUp).Row
در کد بالا first_break اولین جایی که داده قطع شده میده و last_row آخرین ردیف پر
یک شرط قضیه رو تموم میکنه:
حالت اول: first_break زوج هست، پس اولین ردیف فرد خالی میشه first_break+1 و همچنین last_row هم حتما زوج هست پس اولین ردیف زوج خالی میشه last_row+2
حالت دوم: بالعکس بالا
If first_break Mod 2 = 0 Then
oddRow = first_break + 1
eventRow = last_row + 2
Else
oddRow = last_row + 2
eventRow = first_break + 1
End If
پس مشکل رو با دو دستور و یک شرط حل کردیم. بعدش فقط با توجه به نوع farm و product تصمیم بگیرید داده توی کدوم ردیف ذخیره شود.
نکته: در کد مربوط به first_break مقدار cells(1,1) را به اولین سلول ستونی که همیشه در مقصد پر هست تغییر بدید.
گزارش تخلف