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

[farideh_gh]

سلام
چطوری می تونم توی یه فایل اکسل تعریف کنم که توی سطر های خاصی یه پیغام گذاشته بشه . مثلا هر 20 تاسطر یه پیام بذاره
ممنون

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[امين اسماعيلي]

ba drod farz konin mikhain az cell 1 ta 200 , va ba favasele 20 ta 20 ta payami baraton neveshte beshe

For i = 1 To 200
If i Mod 20 = 0 Then
Sheet1.Range("A" & i).Value = "the message that you want should be written here"
End If
Next

on adade 20 ro avaz koni mitoni intervalesho avaz koni, mitoni setono ham avaz koni, agaram adadet bish az 200 hast mitoni ziadesh koni , ya ye moteghayer morefi koni ke tedade adadeto beshmare va bejaye on 200 bekaresh bebari

[fokker]

با سلام آقای اسماعیلی چطور باید این کد رو اکسل ذخیره کرد. ممنون

[sabertb]

با سلام آقای اسماعیلی چطور باید این کد رو اکسل ذخیره کرد. ممنون

برای این کار باید فایلتون رو با پسوند Xlsm ذخیره کنید .

[farideh_gh]

ممنونم بابت کمکتون من کد زیر رو نوشتم که باعث می شه فایلم به تعدادی که میخوام جدا بشه و مابین سطرهای جدا شده به تعدادی که میخوام سطر خالی اضافه بشه .
منتها میخوام توی سطرهای خالی که ایجاد میشه یه پیام بنویسه
جداسازی انجام میشه ولی پیام فقط یکبار داده میشه .
میشه لطف کنید بگید ایرادش کجاس؟ ممنون

Sub Insert_Row()
Dim f As Integer, g As Integer
On Error GoTo Getout
g = InputBox("ÊÚÏÇÏ ÝÇÕáå åÇí ãÇÈíä ÑÇ æÇÑÏ äãÇííÏ")
f = InputBox("ÊÚÏÇÏ ÈÑÇí ÌÏÇÓÇÒí ÑÇ æÇÑÏ äãÇííÏ")
Application.ScreenUpdating = False
If f = 0 Or g = 0 Then Exit Sub
On Error GoTo Getout
Range("A" & 2 + f).Select
" "<>Do While ActiveCell.Value
Range(ActiveCell, ActiveCell.Offset(g - 1, 0)).EntireRow.Insert
" Sheet2.Range("B" & 1 + f + g - 1).Value = " áíÈá
ActiveCell.Offset(1 + f +g - 1, 0).Select
Loop
Getout:
Application.ScreenUpdating = True
End Sub

[امين اسماعيلي]

میشه نمونه فایلتو بزاری. تینجوری من متوجه نمیشم. الن تو offset نوشتی ur اینو از کجا اوردی. اگر فایل بزارین بهتر میشه راهنماییتون کرد

[farideh_gh]

میشه نمونه فایلتو بزاری. تینجوری من متوجه نمیشم. الن تو offset نوشتی ur اینو از کجا اوردی. اگر فایل بزارین بهتر میشه راهنماییتون کرد

اوکی میخوام داخل فایل پیوست مثلا 5 تا 5 تا جدا بشه و بینشون 2 تا سطر اضافه بشه و یه پیغام داخل سطر خالی بذاره
یعنی f=5 , g=2

[farideh_gh]

نمیدونم فایل واستون ارسال شد یانه ؟

[امين اسماعيلي]

با درود
نمیدونم ولی اگر منظورت این بوده که تو تمومه اون سل های خالی ایجاد شده پیام رو بنویسه میشه یه چیزی اینجوری

Dim NumRowsToInsert As Long
Dim RowIncrement As Long
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim LastEvenlyDivisibleRow
Dim i As Long

NumRowsToInsert = 2     'any number greater than 0
RowIncrement = 5      'ditto
Set ws = ActiveSheet
With ws
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastEvenlyDivisibleRow = Int(LastRow / RowIncrement) * RowIncrement
    If LastEvenlyDivisibleRow = 0 Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement
        .Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown
        .Range("A" & i & ":H" & i + (NumRowsToInsert - 1)).Value = "message"
    Next i
End With
Application.ScreenUpdating = True