שאלה | הוספת שורות באקסל לפי נתון מסוים

[מטעמים]

@אביגדור-0 כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

לצורך הגרלה

ראה כאן ותרווה נחת.

[אביגדור 0]

@מטעמים תודה רבה יפה מאוד
איך לעשות הגרלה זה לא העניין כאן כי יש לי אתר יפה להגרלות
אני צריך פשוט להכניס לכל אחד כמה פעמים בהגרלה, לדוג' מי שיש לו 50 נקודות
אני צריך לגרור שיהיה לו 50 שורות ואז אני יכול להדביק את זה התוכנה
@Whenever ניסיתי להדביק באתר עמודות זה לא הולך צריכים דווקא שורות
יש אולי דרך אחרת? אולי בגוגל סקריפט וכדו'
בכל מקרה תודה לכם על הרצון הטוב

[Whenever]

@אביגדור-0 כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

@מטעמים תודה רבה יפה מאוד
איך לעשות הגרלה זה לא העניין כאן כי יש לי אתר יפה להגרלות
אני צריך פשוט להכניס לכל אחד כמה פעמים בהגרלה, לדוג' מי שיש לו 50 נקודות
אני צריך לגרור שיהיה לו 50 שורות ואז אני יכול להדביק את זה התוכנה
@Whenever ניסיתי להדביק באתר עמודות זה לא הולך צריכים דווקא שורות
יש אולי דרך אחרת? אולי בגוגל סקריפט וכדו'
בכל מקרה תודה לכם על הרצון הטוב

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

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

[אביגדור 0]

@Whenever קובץ דוגמה להגרלה.xlsx
תודה רבה
אני צריך בעיקר את מה שרשום בעמדה C שיכפיל שורות לפי מה שרשום בעמדה L
כי עמדה C אני מכניס בתוכנה להגרלות
בכל אופן תודה, זה לא דחוף מתי שיש לך זמן

[Whenever]

מקרו מצורף, רק תחליף אצלך בקובץ את שם הגיליון (הגיליון ולא הקובץ) ל sheet1

בהצלחה!

Sub CreateRowsBasedOnNumber()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    Dim idValue As String
    Dim numberValue As Integer
    
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new worksheet for the output
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "RaffleTickets" ' Name the new sheet
    
    ' Initialize target row counter
    targetRow = 1
    
    ' Find the last row in the source sheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For i = 2 To lastRow ' Assuming headers in the first row
        
        ' Read the ID and number values
        idValue = wsSource.Cells(i, 3).Value ' Column C
        numberValue = wsSource.Cells(i, 9).Value ' Column I
        
        ' Loop to create the required number of rows in the target sheet
        If IsNumeric(numberValue) And numberValue > 0 Then
            For j = 1 To numberValue
                wsTarget.Cells(targetRow, 1).Value = idValue ' Place the ID in Column A of the target sheet
                targetRow = targetRow + 1
            Next j
        End If
        
    Next i

    MsgBox "New sheet created with raffle tickets! Enjoy!", vbInformation

End Sub

[Whenever]

@Whenever כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

מקרו מצורף, רק תחליף אצלך בקובץ את שם הגיליון (הגיליון ולא הקובץ) ל sheet1

בהצלחה!

Sub CreateRowsBasedOnNumber()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    Dim idValue As String
    Dim numberValue As Integer
    
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new worksheet for the output
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "RaffleTickets" ' Name the new sheet
    
    ' Initialize target row counter
    targetRow = 1
    
    ' Find the last row in the source sheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For i = 2 To lastRow ' Assuming headers in the first row
        
        ' Read the ID and number values
        idValue = wsSource.Cells(i, 3).Value ' Column C
        numberValue = wsSource.Cells(i, 9).Value ' Column I
        
        ' Loop to create the required number of rows in the target sheet
        If IsNumeric(numberValue) And numberValue > 0 Then
            For j = 1 To numberValue
                wsTarget.Cells(targetRow, 1).Value = idValue ' Place the ID in Column A of the target sheet
                targetRow = targetRow + 1
            Next j
        End If
        
    Next i

    MsgBox "New sheet created with raffle tickets! Enjoy!", vbInformation

End Sub

אם אתה רוצה למשוך עוד שדות, תעדכן ואוסיף אותם.

[אביגדור 0]

@Whenever תודה רבה עובד מציון
עוד שאלה זה ממש לא דחוף
יש אפשרות שימשוך גם את עמדה D ואח"כ את שורה A, לכל 1
כלומר שיהיה רשום מספר הגרלה, ואח"כ בעמדה B השם ובעמדה C הטלפון

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

[Whenever]

@אביגדור-0 כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

@Whenever תודה רבה עובד מציון
עוד שאלה זה ממש לא דחוף
יש אפשרות שימשוך גם את עמדה D ואח"כ את שורה A, לכל 1
כלומר שיהיה רשום מספר הגרלה, ואח"כ בעמדה B השם ובעמדה C הטלפון

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

Sub CreateRowsBasedOnNumber()
 
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    Dim idValue As String
    Dim phoneNum As String
    Dim nameOfPerson As String
    Dim numberValue As Integer
    
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new worksheet for the output
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "RaffleTickets" ' Name the new sheet
    
    ' Initialize target row counter
    targetRow = 1
    
    ' Find the last row in the source sheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For i = 2 To lastRow ' Assuming headers in the first row
        
        ' Read the ID and number values
        idValue = wsSource.Cells(i, 3).Value ' Column C
        numberValue = wsSource.Cells(i, 9).Value ' Column I
        phoneNum = wsSource.Cells(i, 1).Value ' Column A
        nameOfPerson = wsSource.Cells(i, 4).Value ' Column D
        
        ' Loop to create the required number of rows in the target sheet
        If IsNumeric(numberValue) And numberValue > 0 Then
            For j = 1 To numberValue
                wsTarget.Cells(targetRow, 1).Value = idValue ' Place the ID in Column A of the target sheet
                wsTarget.Cells(targetRow, 2).Value = nameOfPerson ' Place the Name in Column C of the target sheet
                wsTarget.Cells(targetRow, 3).Value = phoneNum ' Place the Phone Number in Column b of the target sheet
                targetRow = targetRow + 1
            Next j
        End If
        
    Next i
 
    MsgBox "New sheet created with raffle tickets! Enjoy!", vbInformation
 
End Sub

עדכנתי אותו שימשוך גם טלפונים ושמות

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

שמחתי לעזור
שבת שלום

[Whenever]

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

Sub CreateRowsBasedOnNumber()
 
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    Dim idValue As String
    Dim phoneNum As String
    Dim nameOfPerson As String
    Dim numberValue As Integer
    
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new worksheet for the output
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "Raf" & "_" & Format(Now(), "YYYY_MM_DD_HH_MM") ' Name the new sheet
    
    ' Initialize target row counter
    targetRow = 1
    
    ' Find the last row in the source sheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For i = 2 To lastRow ' Assuming headers in the first row
        
        ' Read the ID and number values
        idValue = wsSource.Cells(i, 3).Value ' Column C
        numberValue = wsSource.Cells(i, 9).Value ' Column I
        phoneNum = wsSource.Cells(i, 1).Value ' Column A
        nameOfPerson = wsSource.Cells(i, 4).Value ' Column D
        
        ' Loop to create the required number of rows in the target sheet
        If IsNumeric(numberValue) And numberValue > 0 Then
            For j = 1 To numberValue
                wsTarget.Cells(targetRow, 1).Value = idValue ' Place the ID in Column A of the target sheet
                wsTarget.Cells(targetRow, 2).Value = nameOfPerson ' Place the Name in Column B of the target sheet
                wsTarget.Cells(targetRow, 3).Value = phoneNum ' Place the Phone Number in Column C of the target sheet
                targetRow = targetRow + 1
            Next j
        End If
        
    Next i
 
    MsgBox "New sheet created with raffle tickets! Enjoy!", vbInformation
 
End Sub

[ישעיהו כץ]

@אביגדור-0 כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

ניסיתי להדביק באתר עמודות זה לא הולך צריכים דווקא שורות

אתה יכול לעשות כמו שציינו - בעמודות, אח"כ להעתיק הכל ולהדביק (בגיליון חדש) עם החלפה:

תשים לב שאתה מדביק ערכים ולא את הנוסחה עצמה

[Whenever]

@ישעיהו-כץ כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

@אביגדור-0 כתב בשאלה | הוספת שורות באקסל לפי נתון מסוים:

ניסיתי להדביק באתר עמודות זה לא הולך צריכים דווקא שורות

אתה יכול לעשות כמו שציינו - בעמודות, אח"כ להעתיק הכל ולהדביק (בגיליון חדש) עם החלפה:

תשים לב שאתה מדביק ערכים ולא את הנוסחה עצמה

במקרה הזה זה לא עוזר.

זה רגיל

זה אחרי transpose

הוא צריך שורה עבור כל כרטיס של כל משתתף ועם transpose מקבלים שורה לפי סך מספרי כרטיס בלי מזהה של המשתתף.

כל הכבוד על המחשבה מחוץ לקופסה!