Excel Forum

Code: Select all

Public Sub Upload()
Dim Month As String
    Dim Ans, PiNo(100), CelVal As Variant
    Dim FirstRow, i, j, k, l As Integer
    
    Month = InputBox("¡ÃسҡÃÍ¡à´×͹", "Input Month (Ex. Jan , Feb, Mar)")
    Sheets(Month).Activate
    
    FirstRow = 1
    i = 1
    k = 100
    
    While k > 0
          k = k - 1       'k = 100-1 = 99
          i = i + 1        ' i = 1 + 1 = 2
          
          CelVal = Cells(FirstRow + i, 2).Value    ' CelVal = Cells(1+2,2).value
          
          If CelVal <> 0 Then     ' 410253817 <> 0
             ' Reset k while have data row
             k = 100
             j = 0
             ' Create each PiNo
             j = j + 1                      ' j = 0+1 = 1
             PiNo(j) = ""             'PiNo(1) = ""
             
             For l = 1 To Len(CelVal)             'For l = 1 To 9
                 If Asc(Mid(CelVal, l, 1)) <> 10 And Asc(Mid(CelVal, l, 1)) <> 32 Then          ' if 4<>10  And 4<>40 then
                    PiNo(j) = PiNo(j) & Mid(CelVal, l, 1)                                                                     'PiNo(1) = "" & 4
                 Else
                    j = j + 1
                 End If
             Next l
             
             Ans = ""
             
             For l = 1 To j
                  Ans = Ans & WorksheetFunction.VLookup(Val(PiNo(l)), Worksheets("PI").Range("B:C"), 2, 0)
                  If l < j Then Ans = Ans & Chr(10)
             Next l
          
             Cells(FirstRow + i, 3).Value = Ans
          
          
          End If
    Wend

End Sub

Code: Select all

Public Sub Upload()
Dim Month As String
    Dim Ans, PiNo(100), CelVal As Variant
    Dim FirstRow, i, j, k, l As Integer
    
    Month = InputBox("¡ÃسҡÃÍ¡à´×͹", "Input Month (Ex. Jan , Feb, Mar)")
    Sheets(Month).Activate
    
    FirstRow = 1
    i = 1
    k = 100
    
    While k > 0
          k = k - 1       'k = 100-1 = 99
          i = i + 1        ' i = 1 + 1 = 2
          
          CelVal = Cells(FirstRow + i, 2).Value    ' CelVal = Cells(1+2,2).value
          
          If CelVal <> 0 And Len(CelVal) > 7 Then     ' 410253817 <> 0
             ' Reset k while have data row
             k = 100
             j = 0
             ' Create each PiNo
             j = j + 1                      ' j = 0+1 = 1
             PiNo(j) = ""             'PiNo(1) = ""
             
             For l = 1 To Len(CelVal)             'For l = 1 To 9
                 If Asc(Mid(CelVal, l, 1)) <> 10 And Asc(Mid(CelVal, l, 1)) <> 32 Then          ' if 4<>10  And 4<>40 then
                    PiNo(j) = PiNo(j) & Mid(CelVal, l, 1)                                                                     'PiNo(1) = "" & 4
                 Else
                    j = j + 1
                    PiNo(j) = ""
                 End If
             Next l
             
             Ans = ""
             
             For l = 1 To j
                  Ans = Ans & WorksheetFunction.VLookup(Val(PiNo(l)), Worksheets("PI").Range("B:C"), 2, 0)
                  If l < j Then Ans = Ans & Chr(10)
             Next l
          
             Cells(FirstRow + i, 3).Value = Ans
          
          
          End If
    Wend

End Sub

Code: Select all

Dim rngJanAll As Range, rngJan As Range
Dim janStrAll As Variant, i As Integer
Dim strJoin() As Variant, j As Integer
Dim rngPIAll As Range, rngPI As Range

With Worksheets("Jan")
    Set rngJanAll = .Range("b3", .Range("b" & .Rows.Count).End(xlUp))
End With
With Worksheets("PI")
    Set rngPIAll = .Range("b3", .Range("b" & .Rows.Count).End(xlUp))
End With
For Each rngJan In rngJanAll
    janStrAll = Split(rngJan.Value, " ")
    For i = 0 To UBound(janStrAll)
        j = 0
        For Each rngPI In rngPIAll
            If InStr(rngPI, janStrAll(i)) Then
                ReDim Preserve strJoin(j)
                strJoin(j) = rngPI.Offset(0, 1).Value
                j = j + 1
            End If
        Next rngPI
    Next i
    If IsNumeric(VBA.Left(rngJan, 1)) Then
        rngJan.Offset(0, 1).Value = Join(strJoin, vbCrLf)
    End If
Next rngJan