הוספה ומחיקה של עמודות ושורות לפי קריטריונים בקוד VBA

[ל13]

הוספה ומחיקה של עמודות ושורות לפי קריטריונים בקוד VBA

הי,

אשמח לעזרתכם...
יש לי גיליונות אקסל עם טבלאות עם נתונים ונוסחאות שעוברות עדכונים על בסיס שוטף.

מצורף קובץ לדוגמא.

אני צריך לרשום 2 קודי VBA שיאפשרו:

1) העתקת שורה קבועה (עם נוסחאות) והכנסתה (insert) למקום שיסומן בגיליון, ובמקביל מחיקת שורה מסומנת:
אם יוקלד "1" בעמודה A ליד שורה מסויימת, לחיצה על כפתור המאקרו תעתיק את השורה הקבועה (שורה 8) ותכניס אותה (insert) בשלמותה (כולל נוסחאות) מעל השורה שלידה הוקלד "1".
אם יוקלד "0" בעמודה A ליד השורה המסויימת, השורה הזו תימחק בשלמותה.

2) בעמודות התאריכים, בלחיצה על כפתור מאקרו, מחיקת עמודות עם תאריכים של חודש שחלף (לפי הדוגמא - נובמבר 2016) והוספת עמודות חדשות לחודש חדש שלא מופיע עדיין בטבלה (לפי הדוגמא - מרץ 2017), כולל כל הנוסחאות שמופיעות בתאים אלו.

הערה: יש לי כמות גדולה של גיליונות בתבנית זהה עם צורך זהה כמתואר, כך שלמען היעילות והנוחות, אצטרך ש-2 הקודים הללו יוכלו לשרת כל גיליון כשלעצמו ושלא יהיה צורך לשכפל אותם לכל גיליון בנפרד.

תודה מראש

 

[u333]

רק שאלה קטנה.....

האם אתה מחפש מישהו שיעשה לך את העבודה/מטלה/שיעורים ??
או שאולי אתה רוצה ללמוד - ואז תפשיל שרוולים, תתחיל במשימה ואם תתקל בבעיות - תעלה קובץ עם שאלות ספציפיות.
לפחות כך אני מבין את מטרת הפורום.

 

[ל13]

רק תשובה קטנה...

לא... אני לא פונה לפורום שיעשה לי את העבודה...
אני מתאמץ בעצמי למצוא פתרונות, בודק ומנסה למצוא ברשת תבניות של קודים מתאימים כדי שאוכל ללמוד את החוקיות ואת הלוגיקה, מנסה לבצע עריכות בקוד לפי ההיגיון שלי כדי להתאים אותם לצרכיי. במקרים בודדים מצליח אבל לרוב מקבל שגיאות בלי סוף כי חסר לי ידע בסיסי...
כשרמת הידע שלך ב-VBA היא אפסית ומה שלמדת לעשות עד היום זה להקליט מקרואים ופתאום אתה צריך להתמודד עם כתיבת שפת תכנות שמעולם לא התמודדת איתה (או עם כל שפת תכנות אחרת), אז זה קשה כי זה נראה לך סינית וזה מתסכל...
להוכחה, הנה דוגמאות לכמה ניסיונות שלי שלא צלחו (חוץ מאחד שעושה חלק קטן ממה שאני צריך וזה לא מספיק), אני בטוח שאם הייתי מבין את הקוד ברמה טובה, עם כמה תיקונים קטנים זה היה עובד:

'Sub DeleteOldRow()
'DeleteOldRow Macro
'Dim LastRow As Long
'LastRow = [A100000].End(xlUp).Row
'For i = LastRow To 1 Step -1
'If Cells(i, 1) = "מחק שורה" Then Rows(i & ":" & i).EntireRow.Delete
'Next i
'End Sub


'Sub Insert()
'For Each Cell In Range("A:A")
'If Cell.Value = "הוסף שורה >>>" Then
' matchRow = Cell.Row
' Rows("8:8").Select
' Selection.Copy
' Rows(matchRow & ":" & matchRow).Select
' Selection.Insert Shift:=xlDown
'End If
'Next
'End Sub

'Sub AddNewRow()
'AddNewRow Macro
'Dim LastRow As Long
'LastRow = [A100000].End(xlUp).Row
'For i = LastRow To 1 Step -1
'If Cells(i, 1) = "הוסף שורה" Then Rows("8:8").EntireRow.Copy
'Selection.Insert Shift:=xlDown

'End Sub

'Sub AddingNewRow()
'
' AddingNewRow Macro
' Rows("8:8").Select
' Selection.Copy
' ActiveWindow.SmallScroll Down:=6
' Rows("21:21").Select
' Selection.Insert Shift:=xlDown
' ActiveWindow.SmallScroll Down:=3
' Range("A21").Select
'End Sub

לסיכום, מתאים לך לעזור? אשמח. לא מתאים? דלג. לא אכעס.
ובפעם הבאה רק אל תמהר כל כך לשפוט.

תודה.

 

[u333]

חבל שלא קראת עד הסוף...

צרף את הקובץ שלך, עם המקרו שכמעט עובד, עם ההקלטות והתיקונים - לזה התכוונתי.

 

[מיכאל אבידן]

לדעתי אין אלו שיעורי בית. . .

ולא מדובר בקוד פשוט שלומדים בקורסי 'אקסל' למיניהם.

הנה מקרו (מהשרוול וללא השקעה יתרה) שמתאים ללחצן #1.

Sub Micky_Macro_Button_1()
    Application.ScreenUpdating = 0
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    R = 9
   While R <= LR
        If Cells(R, 1) = 1 Then
           Rows(R).Insert shift:=xlShiftDown
           Rows(8).Copy
           Cells(R, 1).PasteSpecial
           Cells(R + 1, 1) = ""
           R = R + 1
           LR = LR + 1
        Else
           If Cells(R, 1) <> "" And Cells(R, 1) = 0 Then
               Cells(R, 1).EntireRow.Delete
               R = R - 1
               LR = LR - 1
           End If
         End If
         R = R + 1
    Wend
    Application.CutCopyMode = 0
    Application.ScreenUpdating = 1
End Sub

 

[u333]

אם לא רוצים שורה זהה כפולה כאשר A9=1 אז....

הייתי מוסיף שורה רביעית בקוד (אחרי R=9):
If [A9] = 1 Then R = 10

 

[מיכאל אבידן]

למי, בדיוק

, כתבת/הגבת

. . .

 

[ל13]

אבחנה יפה מיכאל... ותודה!

אכן, לא מדובר בשיעורי בית של איזשהו קורס...

המון תודה מיכאל

 

[מיכאל אבידן]

BKF. מה עם ניסיונות לפתור את החלק השני

. . .

‏

 

[ל13]

עובד על זה...