Page 1 of 1
ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 9:11 am
by sweetken
ต้องการนำข้อมูลจากไฟล์งานที่ จำนวนชีทไม่แน่นอนมาใช้ เราจะมีวิธีการนับชีทอย่างไรค่ะ ที่จะทำให้ vba จะทราบว่า เราต้องการนับชีทก่อนว่ามีจำนวนชีทเท่าไหร่ แล้วค่อยรันข้อมูลมาอีกชีทหนึ่ง เพื่อเป็นกรารวมข้อมูลสรุป (การนำข้อมูลแต่ละชีทมาสรุปนิดทำได้แล้ว ติดตรงจำนวนชีทที่เพิ่มไม่แน่นอนค่ะ)
ขอบพระคุณค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 9:29 am
by DhitiBank
คำถามเรื่อง VBA ควรเขียนมาเองก่อนครับ แล้วแนบไฟล์ที่ติดปัญหา แต่ถ้าจะลองดูตัวอย่างโค้ดก่อน ลองดูที่ลิ้งค์ด้านล่างครับ
http://www.mrexcel.com/forum/excel-ques ... kbook.html
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 9:39 am
by sweetken
ขอบคุณค่ะ ไม่รู้ต้องใช้ for next หรือเปล่า มีไฟล์ตัวอย่างมาให้ดู คือ หน้า Glass นิดทำข้อมูลได้หมดแล้ว ติดตรงแผ่นชีทจำนวนไม่แน่นอนเลยไปต่อไม่ได้ จะพยายามค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 9:57 am
by niwat2811
Code: Select all
Sub test()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Glass" Then
'other code
End If
Next ws
End Sub
ลองแบบนี้ดูว่าใช้ได้ตามต้องการไหมครับ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 10:17 am
by sweetken
ขอบคุณมากนะคะ จะรีบนำไปประยุกต์ใช้ต่อค่ะ ยังไม่ตรงตามต้องการเท่าไหร่ แต่พอเห็นแนวทางแล้วค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 10:28 am
by sweetken
Code: Select all
Sub Glass()
Application.ScreenUpdating = False
Dim last As Integer
Dim i As Integer
Dim ir As Long
Sheets(1).Select
Range("B5").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Glass"
'Sheets("Glass").Select
[a1] = "Panel"
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(1).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O7:U" & last).Select
'Range("J7:M" & a).Select
Selection.Copy
'Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Glass").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
'sheet2
Sheets(2).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(2).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
'Range("J7:M" & a).Select
Selection.Copy
'Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
'sheet3
Sheets(3).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(3).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
'Range("J7:M" & a).Select
Selection.Copy
'Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
[i5].Select
'sheet4
Sheets(4).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(4).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
'Range("J7:M" & a).Select
Selection.Copy
'Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
'sheet5
Sheets(5).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(5).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
'Range("J7:M" & a).Select
Selection.Copy
'Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
'sheet6
Sheets(6).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(6).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
Selection.Copy
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
'Sheet7
Sheets(7).Select
Range("B5").Select
Selection.Copy
Sheets("Glass").Select
[a300].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(7).Select
Range("o16").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("O8:U" & last).Select
Selection.Copy
Sheets("Glass").Select
Range("B" & last).Select
[b100].End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("a" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) <> "" Then
[a300].End(xlUp).Copy
[a300].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next i
ir = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To ir Step 1
If Range("b" & i) = "" Then
'[a300].End(xlUp).Copy
[a300].End(xlUp).Delete
End If
Next i
Columns("A:H").EntireColumn.AutoFit
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Range("a300").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("A2:g" & last).Select
'Sheets("Glass").[a1].CurrentRegion.Select
'Rows("1" & last).Select
Selection.RowHeight = 18.75
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:F1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&""""&RC[-2]&""""&RC[-1]"
Range("D3").Select
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1000")
Range("D2:D1000").Select
Columns("D:D").EntireColumn.AutoFit
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("a300").Select
Selection.End(xlUp).Select
last = ActiveCell.Row
Range("A2:g" & last).Select
'Sheets("Glass").[a2].CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
Range("A2:G2").Select
Selection.Font.Bold = True
End Sub
พอรันแล้วจะได้หน้า Glass ค่ะ ตอนแรกไม่ทราบว่าจะมีชีทเพิ่ม เลยทำแบบใช้ลำดับชีทเลย ตอนนี้มีชีทเพิ่มเรื่อยๆ เลยต้องหาแนวทางการเขียนใหม่ค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 12:15 pm
by DhitiBank
ปกติแล้ว ชีท "Glass" ไม่มีอยู่ในไฟล์นี้ใช่ไหมครับ

(เห็นในคำสั่งมีการเพิ่มเข้าไปเอง)
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 12:27 pm
by sweetken
ไม่มีค่ะ ชีท Glass ต้องเพิ่มเข้าไปใหม่ แล้วยังต้องมีชีท อลูมิเนียมด้วย ตอนนี้ติดปัญหาที่ว่า พอรันแล้ว มันเอาชีท อลูมิเนียม มารวมด้วย
เลยอยากจะถามว่า เรากันชีทที่ไม่ต้องการจะนำข้อมูลมารวมออกได้ไหมค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 12:37 pm
by DhitiBank
sweetken wrote:ไม่มีค่ะ ชีท Glass ต้องเพิ่มเข้าไปใหม่ แล้วยังต้องมีชีท อลูมิเนียมด้วย ตอนนี้ติดปัญหาที่ว่า พอรันแล้ว มันเอาชีท อลูมิเนียม มารวมด้วย
เลยอยากจะถามว่า เรากันชีทที่ไม่ต้องการจะนำข้อมูลมารวมออกได้ไหมค่ะ
ได้ครับ ต้องดูว่าชีทที่เก็บข้อมูลกระจกต่างจากชีทที่เก็บข้อมูลอะลูมิเนียมยังไง

เช่น อาจเป็นรูปแบบของ "ชื่อชีท" หรืออื่นๆ หากทราบแบบนี้ก็จะสามารถเขียนคำสั่งได้ว่า หากเจอเงื่อนไขแบบนี้ แสดงว่าเป็นชีทประเภทนี้นะ อะไรแบบนี้ครับ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 12:46 pm
by sweetken
เข้าใจแล้วค่ะ ขอบคุณสำหรับคำแนะนำนะคะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 1:07 pm
by DhitiBank
ลองเอาโค้ดนี้ไปปรับใช้ดูครับ
Code: Select all
Sub AddGlass()
Dim ws As Worksheet, wGlass As Worksheet, _
bChk As Boolean, wbAct As Workbook, i As Integer, _
vAny As Variant, r As Range, rG As Range
Set wbAct = ThisWorkbook
'~~> ตรวจว่ามีชีท Glass หรือไม่
For Each ws In wbAct.Sheets
If ws.Name = "Glass" Then bChk = True
Next ws
'~~> หากไม่มีให้สร้าง
If Not bChk Then
wbAct.Sheets.Add after:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Glass"
End If
Set wGlass = wbAct.Sheets("glass")
With wGlass
vAny = Array("Panel", "Glass", "CODE", "Name", "W", "H", "Q'Ty")
.Range("a1").Resize(1, UBound(vAny) + 1).Value = vAny
End With
'~~> เริ่มดึงข้อมูลมาแสดงที่ชีท Glass
For Each ws In wbAct.Sheets
If ws.Name Like "L-*" Then
Set r = ws.Range("o8:o" & ws.Range("o30").End(xlUp).Row)
With wGlass
Set rG = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
.Resize(r.Rows.Count, 1)
End With
rG = ws.Name
rG.Offset(, 1).Value = r.Value
rG.Offset(, 2) = r.Offset(, 3).Value
For i = 4 To 6
rG.Offset(, i).Value = r.Offset(, i).Value
Next i
End If
Next ws
With wGlass
Set rG = .Range("a1").CurrentRegion
End With
Set rG = rG.Offset(1, 3).Resize(rG.Rows.Count - 1, 1)
For Each r In rG
r.Value = r.Offset(, -3).Value & r.Offset(, -2).Value & r.Offset(, -1).Value
Next r
End Sub
สร้างโมดูลใหม่ คัดลอกโค้ดนี้ไปวาง แล้วลองรันดูนะครับ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Fri Aug 19, 2016 1:57 pm
by sweetken
ขอบพระคุณมากค่ะ ใช้ได้ตามต้องการเลยค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Sat Aug 20, 2016 11:35 am
by sweetken
ขอรบกวนอีกนิดนะคะ ถ้าจะให้อธิบายโค๊ดให้หน่อยค่ะ มันยากมากเลยไม่ค่อยเข้าใจค่ะ
Re: ขอคำแนะนำเรื่องการนับชีทที่มีจำนวนไม่แน่นอน VBA
Posted: Sat Aug 20, 2016 12:07 pm
by snasui

ไม่เข้าใจตรงไหนให้ยกมาถามเฉพาะตรงนั้น ค่อยๆ ถามตอบกันไปครับ