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

[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 אך למעשה לא מעתיק.

[OdedDvir]

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

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

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

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

אפשר להוסיף בדיקה שבשחזור יעתיק רק את התאים שגם ביעד הם לא נעולים, אבל אז זה ידרוש שינוי נוסף בקוד.

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

[פלורידה]

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

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

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