ماکرو برای محتویات یک سلول

[hosseinamerey]

دوستان یه ماکرو میخوام که داخل یه سل از شماره 1 تا 365 بشماره و این مقدار مساوی سل کناریش بشه - سل کناری مقدارش 365 - و بعدش میخوام محتویات سل D2 رو پاک کنه و بعد ار اینکه محتویات D2 پاک شد این ماکرو از شماره 1 شروع به شمردن کنه
لطفاً دوستان راهنمایی کنن تا مشکل من حل بشه؟؟

[hosseinamerey]

من این ماژول نوشتم اما میخوام تا 365 ادامه بده و بعدش از یک شروع بشه دوستان لطفا کمک کنن

Option Explicit

Sub Increment()
    Dim lNum As Long
     
    lNum = Cells(4, 4).Value 'A1 change to suit
     'first check that a number is entered
    If Cells(4, 4).Value = "" Then
        lNum = 1
        Cells(4, 4).Value = lNum
    Else
    Cells(4, 4).Value = lNum + 1
    
    End If
End Sub 

[hosseinamerey]

از این ماکرو هم برای پاک کردن محتویات سل اسنفاده کردم
لطفا کمک کنید تا کاملتر کنم

Sub MyMacro()
 
    Dim myLastRow As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    
'   Find last row
    myLastRow = Cells(Rows.Count, "J").End(xlUp).Row
    
'   Loop through range
    For i = 6 To myLastRow
        If Cells(i, "J").Value = 1 Then Range(Cells(i, "O"), Cells(i, "Y")).ClearContents
    Next i
        
    Application.ScreenUpdating = True
    
End Sub 

[hosseinamerey]

از این ماکرو هم برای درست کردن tmp استفاده کردم و مقادیر داخلش ریختم

            Sub clearly()
    Dim ws As Worksheet, wsTemp As Worksheet

    '~~> Create a Temp Sheet
    Set wsTemp = Sheets.Add

    '~~> Copy clipboad data to temp sheet
    wsTemp.Range("A1").PasteSpecial xlPasteAll

    '~~> Clear contents of all sheets except temp sheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsTemp.Name Then ws.Cells.ClearContents
    Next ws

    '~~> Copy data from temp sheet to relevant sheet
    wsTemp.Cells.Copy Sheets("Sheet1").Cells

    '~~> Delete temp sheet
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub 

[hosseinamerey]

   Sheets("Data1").Range("A5:A8").clearcontents
Sheets("Data1").Range("C9").clearcontents
Sheets("Data2").Range("B4:B7").clearcontents
Sheets("Data2").Range("B12").clearcontents 

[hosseinamerey]

                Sub DeleteA5X50()   
    Range("A5:X50").Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    Selection.ClearContents
end sub 

[hosseinamerey]

لطفاً نظراتتون درمورد سوال من و کدهای vba بدید!!!!

[Amir Ghasemiyan]

کسی نبود کمک کنه ؟؟؟؟؟؟؟

اولا اينجا كسي از كسي طلب نداره دوست عزيز، هر كسي هم سوالي جواب ميده يا راهنمايي ميكنه بخاطر لطف و بزرگواريشه
دوما از سوال شما خيلي نگذشته. لااقل بذارين دو سه روز بگذره بعد اگه كسي جوابتونو نداد با لحن مناسبتري درخواست راهنمايي بفرماييد

[hosseinamerey]

اولا اينجا كسي از كسي طلب نداره دوست عزيز، هر كسي هم سوالي جواب ميده يا راهنمايي ميكنه بخاطر لطف و بزرگواريشه
دوما از سوال شما خيلي نگذشته. لااقل بذارين دو سه روز بگذره بعد اگه كسي جوابتونو نداد با لحن مناسبتري درخواست راهنمايي بفرماييد

دوستان متنم اصلاح کردم لطفاً کمک کنید

[hosseinamerey]

دوستان یه ماکرو میخوام که داخل یه سل از شماره 1 تا 365 بشماره و این مقدار مساوی سل کناریش بشه - سل کناری مقدارش 365 - و بعدش میخوام محتویات سل D2 رو پاک کنه و بعد ار اینکه محتویات D2 پاک شد این ماکرو از شماره 1 شروع به شمردن کنه
لطفاً دوستان راهنمایی کنن تا مشکل من حل بشه؟؟

مدیران لطفاً جهت رسیدن به جواب من راهنمایی کنید

[Amir Ghasemiyan]

مدیران لطفاً جهت رسیدن به جواب من راهنمایی کنید

اصلا منظورتون رو متوجه نشدم. همچين چيزي ميخواين؟

Sub counting()
For i = 1 To 365
    If Range("A2").Value = i Then
        GoTo 1
    Else
        Range("A1").Value = i
    End If
Next i
1
Range("D2").Value = ""
End Sub

[hosseinamerey]

ممنونم از کمکت
بله این کد تا 365 میشمره اما من میخوام که هر 24 ساعت (فرقی نمیکنه شمسی یا میلادی) یه شماره بشماره

[hosseinamerey]

تو اکسل از این استفاده کردم برای شمارش تعداد روز

=int(i7-now()) 

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