[حل شده] کپی شدن اطلاعات از یک شیت به انتهای شیت دیگر بصورت مقداری(paste value)-شیت اول با تابع تکمیل میشود ردیف هایی که مقدار تابع صفر نباشد هدف است

[armey]

ضمن عرض ادب و احترام خدمت دوشتان عزیز و اعضای محترم

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

1 - شیت اول با تابع تکمیل می شود هدف کپی شدن سطرهایی است که تابع در آن سطر عددی یافته و در نتیجه مخالف صفر باشد .

2 - اطلاعت به انتهای شیت بایگانی و بصورت مقداری منتقل شود

3- اگر بتواند در سلول اول تاریخ انجام کپی را قید کند که عالی اگر نشود هم مهم نیست

توضیحات فایل :
شیتهای "تخصیصی" و "رول" و "CRM"
روزانه پر می شوند

در شیت "ارسال" روز مقادیر از سه شیت فوق تکمیل و تجویع میشود

ماکرو باید شیت ارسال را بررسی کنند
تمام شیت
هر سطری که مقدار سلول ""I"" در آن صفر نیست
تمام آن سطر را به انتهای شیت "ارسال" بصورت مقداری کپی کند

*شیت ارسال بایگانی و مبع تهیه فاکتور است

کپی-ارسال-روز-با-ارسال.xlsb

با سپاس و تجدید احترام

[armey]

https://forum.exceliran.com/showthread.php/8215-%D8%B1%D9%88%D8%B4-%DA%A9%D9%BE%DB%8C-%DA%A9%D8%B1%D8%AF%D9%86-%DA%A9%D8%A7%D9%85%D9%84-%DB%8C%DA%A9-%D8%B1%D8%AF%DB%8C%D9%81-%D8%A7%D8%B2-%DB%8C%DA%A9-%D8%B4%DB%8C%D8%AA-%D8%A8%D9%87-%D8%B4%DB%8C%D8%AA-%D8%AF%DB%8C%DA%AF%D8%B1-%D8%A7%DA%AF%D8%B1-%D8%B4%D8%B1%D8%B7-%D8%AF%D8%B1%D8%B3%D8%AA-%D8%A8%D9%88%D8%AF?p=43516&viewfull=1#post43516

عزیزان خواسته تقریبا همین کد است که دوست عزیز راهنمایی کردند

فقط در این کد نویسی
اگر سلول a بزرگتر از 100 شود کد برایش در جا اجرا می شود

من میخواهم کد با دستور من با کلیک انجام شود که طبیعتا متصل به یک شیپ است

ولی اجرا برای سلول هایی باشد که سطرهایی باشد سلول a مخالف صفر باشد
(((چون اطلاعات سلول ها با تابع عای مختلف فراخوانی میشود اگر اطلاعاتی نباشد جواب تابع صفر است و ما نیازی به آن نداریم))))

- - - Updated - - -

https://forum.exceliran.com/showthread.php/8215-%D8%B1%D9%88%D8%B4-%DA%A9%D9%BE%DB%8C-%DA%A9%D8%B1%D8%AF%D9%86-%DA%A9%D8%A7%D9%85%D9%84-%DB%8C%DA%A9-%D8%B1%D8%AF%DB%8C%D9%81-%D8%A7%D8%B2-%DB%8C%DA%A9-%D8%B4%DB%8C%D8%AA-%D8%A8%D9%87-%D8%B4%DB%8C%D8%AA-%D8%AF%DB%8C%DA%AF%D8%B1-%D8%A7%DA%AF%D8%B1-%D8%B4%D8%B1%D8%B7-%D8%AF%D8%B1%D8%B3%D8%AA-%D8%A8%D9%88%D8%AF?p=43516&viewfull=1#post43516

[armey]

دوستان عزیز ، اعضای محترم
خواهشمندم اگه مقدوره و در توان هست کمک بفرمایید

با سپاس

[iranweld]

دوستان عزیز ، اعضای محترم
خواهشمندم اگه مقدوره و در توان هست کمک بفرمایید

با سپاس

با سلام

کدهای نمایش داده شده در قسمت کدنویسی شیت یک را حذف نمایید و از کدهای ماژول یک استفاده نمایید

[armey]

با سلام

کدهای نمایش داده شده در قسمت کدنویسی شیت یک را حذف نمایید و از کدهای ماژول یک استفاده نمایید

[ATTACH=CONFIG]23090[/ATTACH]

با سلام

کدهای نمایش داده شده در قسمت کدنویسی شیت یک را حذف نمایید و از کدهای ماژول یک استفاده نمایید

[ATTACH=CONFIG]23090[/ATTACH]

بسیار بسیار بسیار
سپاسگذارم دوست عزیز بابت لطفتون

جسارتا دوتا سوال داشتم
(قصور از خودم بود سوال رو درست تشریح نکردم )

در کد ارائه شده شما :

Sub TEST()

Z = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
K = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1


For I = 1 To Z


If IsNumeric(Sheet1.Range("A" & I).Value) And Sheet1.Range("A" & I).Value >= 100 Then


Sheet1.Range(I & ":" & I).Select
Selection.Cut
Sheets("Sheet2").Select


    Rows(K & ":" & K).Select
    ActiveSheet.Paste
    Range("A" & K).Select
    
   Sheets("Sheet1").Select
   Range("A" & I).Select


'MsgBox "OK"
End If
Next




End Sub

• اگر بخواهیم در سطر

If IsNumeric(Sheet1.Range("A" & I).Value) And Sheet1.Range("A" & I).Value >= 100 Then

بگویم بررسی کن
اگر سلول A حاوی مقدار بود سطر را کپی کن

Value >= 100 Then

رو به
=""
تغییر دادم ولی نشد .

• بجای کات دادن یعنی منتقل کردن به شیت بعدی کپی کند یعنی اطلاعات شیت اول کپی شود((شیت یک دارای فرمول است و اطلاعات باید کپی شود ))

• مقدوره کد جایگزینی رو لطف بفرمایید

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

[iranweld]

بسیار بسیار بسیار
سپاسگذارم دوست عزیز بابت لطفتون

جسارتا دوتا سوال داشتم
(قصور از خودم بود سوال رو درست تشریح نکردم )

در کد ارائه شده شما :

Sub TEST()

Z = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
K = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1


For I = 1 To Z


If IsNumeric(Sheet1.Range("A" & I).Value) And Sheet1.Range("A" & I).Value >= 100 Then


Sheet1.Range(I & ":" & I).Select
Selection.Cut
Sheets("Sheet2").Select


    Rows(K & ":" & K).Select
    ActiveSheet.Paste
    Range("A" & K).Select
    
   Sheets("Sheet1").Select
   Range("A" & I).Select


'MsgBox "OK"
End If
Next




End Sub

• اگر بخواهیم در سطر

If IsNumeric(Sheet1.Range("A" & I).Value) And Sheet1.Range("A" & I).Value >= 100 Then

بگویم بررسی کن
اگر سلول A حاوی مقدار بود سطر را کپی کن

Value >= 100 Then

رو به
=""
تغییر دادم ولی نشد .

• بجای کات دادن یعنی منتقل کردن به شیت بعدی کپی کند یعنی اطلاعات شیت اول کپی شود((شیت یک دارای فرمول است و اطلاعات باید کپی شود ))

• مقدوره کد جایگزینی رو لطف بفرمایید

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

با سلام

کد جایگزین

If  Sheet1.Range("A" & I) <> "" Then 

کد تغییر حروف عربی "ی" و "ک" به فارسی

Sub test()

  
    
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
        cell.Value = WorksheetFunction.Trim(cell)
    Next cell
    
    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next
    
 


End Sub

[armey]

با سلام

کد جایگزین

if  sheet1.range("a" & i) <> "" then 

کد تغییر حروف عربی "ی" و "ک" به فارسی

sub test()

  
    
    for each cell in activesheet.usedrange.specialcells(xlcelltypeconstants)
        cell.value = worksheetfunction.trim(cell)
    next cell
    
    cells.replace what:=chrw(1610), replacement:=chrw(1740), lookat:=xlpart, searchorder _
        :=xlbyrows, matchcase:=false, searchformat:=false, replaceformat:=false
    cells.replace what:=chrw(1603), replacement:=chrw(1705), lookat:=xlpart, searchorder _
        :=xlbyrows, matchcase:=false, searchformat:=false, replaceformat:=false
        
    next
    
 


end sub

بزرگوار خیلی لطف کردید

• موارد منتقل میشوند هدفم اینه کپی بشند

علت اینه که شیت اول در فایل اصلی فرمول داره وقتی با کد شما منتقل میشوند اینور فرمولهام بهم میخوره

شرط باید این رو بگه
در شیت جاری
در ستون "a" هر سلولی که پر بود یا مخالف صفر بود کل سطر کپی شود به انتهای شیت 2
ملاحظات : با این کار سطر اول هم کپی میشه (سرتیتر)
اومدم یه ستون کمکی ایجاد کردم با فرمول if
گفتم اگر سلول مورد نظر دیتا داشتد 1 بزاره نداشت خالی باشه
به کد شما هم بررسی ستون کمکی رو دادم
هدف انجام شد
فقط الان مشکل اینه سطر هایی رو که پیدا میکنه کات میده به شیت مقصد باید کپی کنه یعنی سطر از شیت اول پاک نشود

- - - Updated - - -

با سلام

کد جایگزین

If  Sheet1.Range("A" & I) <> "" Then 

کد تغییر حروف عربی "ی" و "ک" به فارسی

Sub test()

  
    
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
        cell.Value = WorksheetFunction.Trim(cell)
    Next cell
    
    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next
    
 


End Sub

بزرگوار خیلی لطف کردید

• موارد منتقل میشوند هدفم اینه کپی بشند

علت اینه که شیت اول در فایل اصلی فرمول داره وقتی با کد شما منتقل میشوند اینور فرمولهام بهم میخوره

شرط باید این رو بگه
در شیت جاری
در ستون "A" هر سلولی که پر بود یا مخالف صفر بود کل سطر کپی شود به انتهای شیت 2
ملاحظات : با این کار سطر اول هم کپی میشه (سرتیتر)
اومدم یه ستون کمکی ایجاد کردم با فرمول IF
گفتم اگر سلول مورد نظر دیتا داشتد 1 بزاره نداشت خالی باشه
به کد شما هم بررسی ستون کمکی رو دادم
هدف انجام شد
فقط الان مشکل اینه سطر هایی رو که پیدا میکنه کات میده به شیت مقصد باید کپی کنه یعنی سطر از شیت اول پاک نشود

[iranweld]

این کد cut را به copy تغییر بدید


- - - Updated - - -

و برای اینکه از سطر خاصی شروع بکار کنه عدد یک را به شماره سطر مورد نظر تغییر بدید

[armey]

خطای کدجایگزینی عربی با فارسی

- - - Updated - - -

[COLOR=#333333]Sub test()[/COLOR]
  
    
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
        cell.Value = WorksheetFunction.Trim(cell)
    Next cell
    

    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next
    
 

 [COLOR=#333333]End Sub[/COLOR]

[armey]

این کد cut را به copy تغییر بدید


- - - Updated - - -

و برای اینکه از سطر خاصی شروع بکار کنه عدد یک را به شماره سطر مورد نظر تغییر بدید

انتقال--ارسال-روز-به-ارسال-کل-و-جایگزینی-حروف-عربی.xls

انتقال--ارسال-روز-به-ارسال-کل-و-جایگزینی-حروف-عربی.xls


ویرایش شده بر اساس کمک های شما

[iranweld]

فایل پیوست را بررسی کنید