אקסל | בחירת טווח עמודות בכל הטבלאות

[OdedDvir]

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

אני צריך את זה לפקודות שיחולו על כל טבלה באשר היא

כיצד יחולו הפקודות, על ידי VBA? אם כן, תוכל לבחור את הטווח על ידי הפונקציה Range.
לדוגמא, כדי לסמן את העמודות B עד E תשתמש בפקודה הבאה:

Range("B:E").Select

[פלורידה]

@odeddvir אמר באקסל | בחירת טווח עמודות בכל הטבלאות:

לאיזו מטרה אתה רוצה לבחור את העמודות

דוגמאות:

1. אני רוצה לערוך טבלה שתסכם לי את כל הנתונים הנמצאים בעמודה 1 מכל הטבלאות הקיימות בגליון. אני מכניס את הפונקציה הבאה, אבל זה יועיל לי רק ל"טבלה1" אני רוצה שיכלול לי גם את טבלה2 וכו', (בלי לכתוב ידנית את כל השמות של הטבלאות...)

=SUBTOTAL(103,טבלה1[[עמודה2]:[עמודה5]])

2. החלת עיצוב מותנה על הטווח הנ"ל. וכן הלאה...

[OdedDvir]

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

ואתה רוצה לחשב את סכום העמודה הראשונה בארבעת הגליונות הראשונים (ברכות עד פסחים), תרשום את הנוסחה הבאה:

=SUM('ברכות:שבת'!A:A)

שים לב שהנוסחא SUBTOTAL(103,....) לא תומכת בטווח תלת מימדי (כפי שכתוב בקישור שהבאתי בהתחלה), אבל תוכל להשתמש בצורה המפורשת:

=COUNTA('ברכות:שבת'!A:A)

יתר על כן, תוכל אפילו לציין WildCard (ג'וקר?) כגון כוכבית * בשמות הגליונות, כך:

=SUM('*גליון*'!A:A)

כדי לבחור בקלות את גליונות 4 עד 7.

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

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

[פלורידה]

@odeddvir

אני מדבר על כמה טבלאות באותו הגיליון, שאני מעוניין לעשות Select לחלק מסויים ([עמודה2]:[עמודה5]) מכל הטבלאות (כלומר אני מעוניין שלא יהיה כפוף לשם טבלה). אני מעלה תמונה להראות מה אני מתכוון.

[OdedDvir]

@פלורידה ציינתי לך לעיל שאפשר על ידי VBA.
בדוגמא שהבאת אתה מבקש לבחור את התחומים הבאים:

D8:G29
K8:N24
וכו'

כנס לעורך VBA ובחלון ה Immediate תקליד את הפקודה הבאה:

Range("D8:G29, K8:N24").Select

זה לא פתרון מושלם לכל הגליונות, כי מסתמא הטווחים שונים מגליון לגליון.
יש אפשרות לטפל גם בזה:

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

[פלורידה]

@odeddvir אמר באקסל | בחירת טווח עמודות בכל הטבלאות:

ניתן לכתוב קוד שיסרוק את הגליון ויאתר את הטווחים הרצויים, לפי העיצוב

אשמח לכיוון/מראה מקום

[מנחם]

זה הכיוון

Sub LoopThroughAllTablesWorksheet()

'Create variables to hold the worksheet and the table
Dim ws As Worksheet
Dim tbl As ListObject

Set ws = ActiveSheet
'Loop through each table in worksheet
For Each tbl In ws.ListObjects
    'Do something to the Table....

Next tbl

End Sub

וזה המראה מקום

[OdedDvir]

@פלורידה הקוד של @מנחם הוא התחלה מצויינת, שים לב שבמקרה המסויים שלך ("הדרך עלך") יש קושי מסויים כיוון שיש טבלאות אחרות שאותן אתה לא מעוניין לבחור: שורת הסיכום וההתקדמות לפי תאריך, כך שצריך לבצע בדיקה על כל טבלה האם היא רלוונטית לבחירה או לא.

[פלורידה]

@מנחם תודה רבה!! (על הדגים, ובעיקר על החכה...)

@OdedDvir אני יכול להוסיף תנאי שהתאים מוגדרים לעיצוב תאים של תאריך. ואם לא ידלג לטבלה הבאה?

[OdedDvir]

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

Public Sub MarkAllTableCellsByFormat(formatPattern As String)
    Dim tbl As ListObject
    Dim cl As Range
    Dim selectedArea As Range

    For Each tbl In ActiveSheet.ListObjects
        For Each cl In tbl.Range.Cells
            If InStr(cl.NumberFormat, formatPattern) Then
                If selectedArea Is Nothing Then
                    Set selectedArea = cl
                Else
                    Set selectedArea = Union(selectedArea, cl)
                End If
            End If
        Next cl
    Next tbl
    If Not selectedArea Is Nothing Then selectedArea.Select
End Sub

בקריאה לפונקציה יש לספק את מחרוזת העיצוב, למשל עבור עיצוב תאריך "m/d/yyyy"

MarkAllTableCellsByFormat "m/d/yyyy"

[פלורידה]

@odeddvir

אם אני רוצה ליצור data שם יהיה כתוב הטווח הנ"ל, כיצד?

[OdedDvir]

@פלורידה עכשיו אני כן מנחש מה אתה זומם...
תוכל לקבל את הטווח על ידי selectedArea.Address

[פלורידה]

@odeddvir

selectedArea.Address

לא הצלחתי להבין באיזה אופן אני משתמש בזה?
היכן אני מכניס את זה, (בתוך הקוד הקודם? בחלון של ההרצה?)
היכן אני אמור לקבל את הטווח?

[פלורידה]

האם אפשר לתת שם לטווח בשתי גליונות? או רק בגליון אחד?

[OdedDvir]

@פלורידה אפשר לתת שם טווח בכמה גליונות על ידי ציון שם הגליון ולאחריו סימן הקריאה !, ולהפריד בין הטווחים על ידי פסיקים , כלומר כך:

[ברכות]!A:B,[עירובין]!C:D

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

אבל כעת אין לי זמן לזה. בעז"ה במוצ"ש בלי נדר.

[פלורידה]

@odeddvir

אני התכוונתי במנהל השמות, אם אפשר לקרוא שם במנהל השמות.

אבל כמו שאתה אומר זה לא יעזור.

אני מעלה קובץ שכבר נתתי שמות לטווחים של הסימון בכל גליון (שם הטווח הוא שם הגליון.) (אולי באמת נכון יותר יהיה להמשיך בנושא שם. )

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

https://send.magicode.me/send-file/file/a8b71a091ae2781816bd4136864d7e5ce8e5039c/view

ותודה רבה לך על העזרה

(באם באמת תמצא זמן לעסוק בזה, אשמח אם תפצל את המודולים לגיבוי ושחזור, כדי שאני יוכל לשים MsgBox לבדיקת שגיאות אם השחזור / גיבוי הצליח /לא הצליח, וכדו'.)

[OdedDvir]

@פלורידה הקובץ הנ"ל משובש מבחינת הטווחים. הם לא רציפים.
ובלאו הכי יש גישה יותר פשוטה, והיא לבחור את כל התאים שאינם נעולים.
הנה פונקציה שמחזירה את טווח התאים שאינם נעולים (בטבלאות בלבד):

Public Function GetAllUnlockedTableCellsInWorksheet(ws As Worksheet) As Range
    Dim tbl As ListObject
    Dim cl As Range
    Dim selectedArea As Range

    For Each tbl In ws.ListObjects
        For Each cl In tbl.Range.Cells
            If Not cl.Locked Then
                If selectedArea Is Nothing Then
                    Set selectedArea = cl
                Else
                    Set selectedArea = Union(selectedArea, cl)
                End If
            End If
        Next cl
    Next tbl
    Set GetAllUnlockedTableCellsInWorksheet = selectedArea
End Function

והנה פונקציה להעתקה של תאים אלו מגליון לגליון, כולל יצירה של גליון היעד אם אינו קיים:

Public Sub CopyAllUnlockedTableCells(sourceWorkbook As Workbook, targetWorkbook As Workbook)
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim singleArea As Range
    Dim singleAreaAddress As String
    
    MsgBox "מתכונן להעתקת הגליונות, אנא המתן בסבלנות"
    Application.Cursor = xlWait
    For Each sourceSheet In sourceWorkbook.Sheets
        Set sourceRange = GetAllUnlockedTableCellsInWorksheet(sourceSheet)
        If Not sourceRange Is Nothing Then
            On Error Resume Next
            Set targetSheet = targetWorkbook.Worksheets(sourceSheet.Name)
            On Error GoTo 0
            If targetSheet Is Nothing Then
                targetWorkbook.Sheets.Add.Name = sourceSheet.Name
                Set targetSheet = targetWorkbook.Worksheets(sourceSheet.Name)
            End If
            Debug.Print "Copying sheet: " & sourceSheet.Name
            For Each singleArea In sourceRange.Areas
                singleAreaAddress = singleArea.Address
                targetSheet.Range(singleAreaAddress).Value = singleArea.Value
            Next singleArea
        End If
        Set targetSheet = Nothing
    Next sourceSheet
    Application.Cursor = xlDefault
    MsgBox "העתקת הגליונות הושלמה"
End Sub

כעת לגיבוי ושחזור נשנה גם את הפונקציות, כך שיבחרו את התאים שאינם נעולים:

Public Sub BackupTo(targetWorkbook As String)
   CopyAllUnlockedTableCells ThisWorkbook, Workbooks.Open(targetWorkbook)
End Sub
 
Public Sub RestoreFrom(sourceWorkbook As String)
   CopyAllUnlockedTableCells Workbooks.Open(sourceWorkbook), ThisWorkbook
End Sub

וכדי לגבות או לשחזר לקובץ בשם גיבוי.xlsx שבתיקיה הנוכחית:

BackupTo ActiveWorkbook.Path & "\גיבוי.xlsx"
RestoreFrom ActiveWorkbook.Path & "\גיבוי.xlsx"

[פלורידה]

@odeddvir תזכה למצוות!!

העתקתי את כל הקודים למודול אחד, והרצתי את הגיבוי, אך הוא לא פעל כמצופה.
הוא אמנם בחר את כל התאים הנ"ל. וגם הוא פתח גליון אחד נוסף בשם מסכת ברכות, אך לא העתיק אליו מאומה. ויותר לא פתח גליונות.

[OdedDvir]

@פלורידה
תיקנתי טעות קטנה בקוד של הפונקציה CopyAllUnlockedTableCells...
שים לב שהקוד שצירפתי עובד לאט מאד...
ההפרדה בין האזורים והעתקתם אחד אחד היא איטית מאוד, משהו כמו דקה עבור כל חוברת העבודה. אני לא הצלחתי לשפר את המהירות.
בכל מקרה, הוספתי הודעה לפני ואחרי ההעתקה, והפכתי את הסמן לספינר כדי לתת למשתמש אינדיקציה מתי התהליך הסתיים.
יהיה נחמד להוסיף מד-התקדמות Progress Bar כדי לתת חוויה יותר נעימה למשתמש.

[פלורידה]

@odeddvir אמר באקסל | בחירת טווח עמודות בכל הטבלאות:

@פלורידה
תיקנתי טעות קטנה בקוד של הפונקציה CopyAllUnlockedTableCells...
שים לב שהקוד שצירפתי עובד לאט מאד...
ההפרדה בין האזורים והעתקתם אחד אחד היא איטית מאוד, משהו כמו דקה עבור כל חוברת העבודה. אני לא הצלחתי לשפר את המהירות.
בכל מקרה, הוספתי הודעה לפני ואחרי ההעתקה, והפכתי את הסמן לספינר כדי לתת למשתמש אינדיקציה מתי התהליך הסתיים.
יהיה נחמד להוסיף מד-התקדמות Progress Bar כדי לתת חוויה יותר נעימה למשתמש.

רוב תודות....

אל ייחר לאדוני ואדברה אך הפעם... הקוד לשחזור, מפעיל רק את ה MsgBox's אך למעשה לא מעתיק.