ปรุงก่อนชิม
Location :
นนทบุรี Thailand

[Profile ทั้งหมด]

ฝากข้อความหลังไมค์
Rss Feed
Smember
ผู้ติดตามบล็อก : 4 คน [?]




New Comments
Group Blog
 
All Blogs
 
Friends' blogs
[Add ปรุงก่อนชิม's blog to your web]
Links
 

 
VBA Excel บันทึกผลบอล

  Load ได้จาก Link นี้




copy code ที่ Module1
Option Explicit
Dim lastData As Long
Sub Button1_Click()
Dim N As Integer: N = 0
Dim sRow As Integer: sRow = 0
 Dim firstTeam As String: Dim Score As String: Dim SecondTeam As String
Range("B4").Select
Do Until ActiveCell.Value = ""
N = N + 1
firstTeam = Cells(3 + N, 2).Value
Score = Cells(3 + N, 3).Value
SecondTeam = Cells(3 + N, 4).Value
Call getCalculateResult(N, firstTeam, Score, SecondTeam)
Selection.Offset(1, 0).Select
Loop
Call consolidateData(lastData)
'---count rows
Range("G4").Select
Do While ActiveCell.Value <> ""
sRow = ActiveCell.Row
Selection.Offset(1, 0).Select
Loop
Call Module1.final_sort(sRow)

End Sub
Sub getCalculateResult(records As Integer, firstTeam As String, Score As String, SecondTeam As String)
Dim R, B As Integer: B = 2: R = 1 + (records * 2)
Dim SC As Variant
Dim X, Y As Integer
Dim result1, result2 As Integer
SC = Split(Score, "-")
X = SC(0)
Y = SC(1)
Debug.Print X & "-" & Y
'---------- Calculate result
If X > Y Then result1 = 3
If X = Y Then result1 = 1
If X < Y Then result1 = 0
If result1 = 3 Then result2 = 0
If result1 = 1 Then result2 = 1
If result1 = 0 Then result2 = 3
'---------- plot score
Cells(B + R - 1, 7).Value = firstTeam: Cells(B + R - 1, 8).Value = result1
Cells(B + R, 7).Value = SecondTeam: Cells(B + R, 8).Value = result2
lastData = B + R
End Sub

Sub consolidateData(LData As Long)
Dim lRow As Long
Dim ItemRow1, ItemRow2 As String
Dim lengthRow1, lengthRow2 As String
Range(Cells(4, 7), Cells(LData, 8)).Select
Call Module1.first_sort(LData)
    lRow = 4
    Cells(lRow, "G").Select
Do While (Cells(lRow, "G") <> "")
        ItemRow1 = Cells(lRow, "G")
        ItemRow2 = Cells(lRow + 1, "G")
                If (ItemRow1 = ItemRow2) Then   '-----same team is true
                            Cells(lRow, "H") = Cells(lRow, "H") + Cells(lRow + 1, "H") '-------sum
                                Range(Cells(lRow + 1, "G"), Cells(lRow + 1, "H")).Select
                                Selection.Delete Shift:=xlUp
                                Cells(lRow + 1, "G").Select
                Else
                            lRow = lRow + 1
                End If
Loop
End Sub
Sub first_sort(LD As Long)
    Range(Cells(4, "G"), Cells(LD, "H")).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G4:G" & LD) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("G4:G" & LD)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub first_sort_(LD As Long)
    Range("G4:H27").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G4:G27") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("G4:H27")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub final_sort(LD As Integer)
    Range("G4:H" & LD).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("H4:H" & LD), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("G4:H" & LD)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub




Create Date : 04 มกราคม 2557
Last Update : 4 มกราคม 2557 12:34:05 น. 0 comments
Counter : 950 Pageviews.

ชื่อ :
Comment :
  *ใช้ code html ตกแต่งข้อความได้เฉพาะสมาชิก
 
 Pantip.com | PantipMarket.com | Pantown.com | © 2004 BlogGang.com allrights reserved.