רוצה לעזור לכם באקסל

[מאסטר באקסל]

למה כתבת עמודה I?

אתה מה אכפת לך?!
כי בדוגמה, זוהי העמודה שמכילה את ה"שולם" במידה וקיים.

 

[מרובע]

אתה מה אכפת לך?!
כי בדוגמה, זוהי העמודה שמכילה את ה"שולם" במידה וקיים.

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

 

[אפר]

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

אם היה דולר לפני המספר אז היה בודק רק בשורה 1 אבל כשאין דולר אז זה יחסי לכל שורה

 

[מרובע]

אם היה דולר לפני המספר אז היה בודק רק בשורה 1 אבל כשאין דולר אז זה יחסי לכל שורה

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

 

[אפר]

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

זה ישתנה לפי היחס לשורה הראשונה
אותו דבר נכון גם לעמודות

 

[xl3391]

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

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

 

[מרובע]

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

לא ממש הבנתי מה זה כן עושה. תוכל לתת דוגמא בבקשה?

 

[xl3391]

לא ממש הבנתי מה זה כן עושה. תוכל לתת דוגמא בבקשה?

למשל טבלה כזאת:

תפוצל לקבצים או גיליונות כך:

 

[מרובע]

הוא בעצם מפריד את השורות לגליונות שונים לפי שם העיר.

לי יש טבלה כזו:

ואני רוצה להפריד אותה לשני גליונות:

א:

ב:

האם יעזור אם אדביק את התוכן במהופך (זאת אומרת להפוך שורות לעמודות )?

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

 

[xl3391]

האם יעזור אם אדביק את התוכן במהופך (זאת אומרת להפוך שורות לעמודות )?

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

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

מאקרו חדש.

 

[אפר]

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


מאקרו חדש.

אפשר להפריד לאחר ההיפוך עם נוסחה, מילוי מהיר או טקסט לעמודות
ואז להפעיל את התוסף

 

[מרובע]

ואם אעביר את כל שמות הערים לשורה נפרדת זה יעזור?
כמו בתמונה

 

[אפר]

אפשר להפריד לאחר ההיפוך עם נוסחה, מילוי מהיר או טקסט לעמודות
ואז להפעיל את התוסף

ואם אעביר את כל שמות הערים לשורה נפרדת זה יעזור?
כמו בתמונה

צפה בקובץ המצורף 708979

 

[מרובע]

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

 

[אפר]

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

אם אתה בעניין...

 

[מרובע]

להלן הקוד:

Sub ShowSplitToFilesForm()
strPrompt = "על מנת שהתוכנית תעבוד כראוי יש לוודא כי לכל עמודה בנתונים שלך יש כותרת" _
& vbNewLine & "וכי הכותרות נמצאות בשורה 1." & vbNewLine & "האם להמשיך?"
uns = MsgBox(strPrompt, vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "חשוב!")
'אם המפעיל בחר להמשיך מוצג הטופס לבחירת כותרת
 If uns = vbYes Then
   FrmGetHeader.Show
 End If
End Sub
'והכותרת שנבחרה עוברת לתוכנית זו
Sub SplitTableByValue(valueHeader, toFilesOrToSheets As String)
Dim tempName As String, clm As Integer
Application.ScreenUpdating = False
  pt = ActiveWorkbook.Path
  myFile = ActiveWorkbook.Name
  sht = ActiveSheet.Name
  'ראשית תאותר מספר העמודה של הכותרת שנבחרה ולאחר מכן
   Rows("1:1").Select
    Selection.Find(What:=valueHeader, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
  clm = ActiveCell.Column
 'יועברו ערכי העמודה לגליון חדש וימחקו הכפולים
   Columns(clm).Copy
   Sheets.Add After:=Sheets(Sheets.Count)
   Selection.PasteSpecial Paste:=xlPasteValues
   Selection.PasteSpecial Paste:=xlPasteFormats
   Application.CutCopyMode = False
  r = Range("A1000000").End(xlUp).Row
   ActiveSheet.Range("$A$1:$A$" & r).RemoveDuplicates Columns:=1, Header:=xlYes
  r = Range("A1000000").End(xlUp).Row
  tempSheet = ActiveSheet.Name
'תתחיל ריצה על ערכי העמודה וסינון ערכיה בטבלה
If toFilesOrToSheets = "toFiles" Then
For i = 2 To r
       tempName = Range("A" & i).Value
       Sheets(sht).Select
       Range("B1").Select
       ActiveSheet.Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).AutoFilter Field:=clm, Criteria1:= _
        tempName
       Range("A1").Select
       Range(Selection, ActiveCell.SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy
       Workbooks.Add
       Selection.PasteSpecial Paste:=xlPasteValues
       Selection.PasteSpecial Paste:=xlPasteFormats
       Cells.EntireColumn.AutoFit
       [A1].Select
       Application.CutCopyMode = False
      tempName = removeSpecialChars(tempName)
     'שמירת נתונים מסוננים כקובץ נפרד כאשר שם הקובץ הוא הערך שסונן
       ActiveWorkbook.SaveAs Filename:=pt & "/" & tempName & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       ActiveWindow.Close
       Workbooks(myFile).Activate
       Sheets(tempSheet).Select
   Next i
 Else
   For i = 2 To r
       tempName = Range("A" & i).Value
       Sheets(sht).Select
       Range("B1").Select
       ActiveSheet.Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).AutoFilter Field:=clm, Criteria1:= _
        tempName
       Range("A1").Select
       Range(Selection, ActiveCell.SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy
      'נתונים מסוננים עוברים לגיליון נפרד
       Sheets.Add After:=Sheets(Sheets.Count)
       Selection.PasteSpecial Paste:=xlPasteValues
       Selection.PasteSpecial Paste:=xlPasteFormats
       Cells.EntireColumn.AutoFit
       [A1].Select
       Application.CutCopyMode = False
      tempName = Left(removeSpecialChars(tempName), 30)
     ' הגיליון מקבל את שם הערך שסונן
       ActiveSheet.Name = tempName
       Sheets(tempSheet).Select
    Next i
 End If
   Sheets(tempSheet).Delete
   Sheets(sht).Select
   Selection.AutoFilter
   MsgBox ("סיים")
   Application.ScreenUpdating = True
 
End Sub

Function removeSpecialChars(myText As String)
For i = 1 To Len(myText)
 c = Mid(myText, i, 1)
 If c = " " Or (Asc(c) > 64 And Asc(c) < 91) Or (Asc(c) > 96 And Asc(c) < 123) Or (Asc(c) > 223 And Asc(c) < 251) Or (Asc(c) > 47 And Asc(c) < 58) Then
  removeSpecialChars = removeSpecialChars & c
 End If
Next i
End Function

האם יעזור שכל מקום שכתוב row נחליף לcolumn ולהיפך?
או שיש כאן עוד דברים שצריך לשנות בשביל זה

 

[xl3391]

הקוד עובד על סינון וממש לא קשור.
כמה עמודות יש לך לכל עיר? 2?
אם כן אז אם תשאיר רק את שם העיר ותמיין עמודות לפי שם העיר (כך שהחל מעמודה B כל שתי עמודות רצופות שייכות לאותה עיר) תוכל להריץ את הקוד הבא:

Sub CityToSheets()
    Dim i As Integer
    i = 2
    Do While Cells(1, i).Value <> ""
    
        Range(Columns(i), Columns(i + 1)).Copy
        Sheets.Add.Name = Sheets("שם גיליון שבו הטבלה").Cells(1, i).Value
        [B1].Select
        ActiveSheet.Paste
        
        Sheets("שם גיליון שבו הטבלה").Select
        i = i + 2

    Loop
End Sub

 

[מרובע]

הוא לא נותן לי להפעיל את הקוד

 

[Cהרשי]

שלום רב,

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

איך אני מחזיר את לשונית הגיליון לתצוגה בתחתית העמוד?

 

[xl3391]

הוא לא נותן לי להפעיל את הקוד

צפה בקובץ המצורף 709302

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

Sub CityToSheets()
    Dim i As Integer
    Dim sh As String
    
    i = 2
    sh = ActiveSheet.Name
    
    Do While Cells(1, i).Value <> ""
    
        Range(Columns(i), Columns(i + 1)).Copy
        Sheets.Add.Name = Sheets(sh).Cells(1, i).Value
        [B1].Select
        ActiveSheet.Paste
        
        Sheets(sh).Select
        i = i + 2

    Loop
    Application.CutCopyMode = False
    
End Sub