這是 Libre Office Calc 可以跑的程式碼，應該可以轉成 Excel 用的
轉換規則我想應該是這樣：

• ThisComponent.getCurrentController.activesheet => ActiveSheet
• ThisComponent.Sheets.getByName("aaa") => Sheets("aaa")
• .getCellByPosition(x, i).string => .Cells(i+1, x+1).Value
• .getCellByPosition(x, i).Value => .Cells(i+1, x+1).Value
• 另外我 while 迴圈那邊的 t <> "" ，我不確定 Excel 會怎麼判斷，還是應該要用 Nothing 來判斷，可能也要改一下

Sub Main
	Dim curSheet, dataSheet
	curSheet = ThisComponent.getCurrentController.activesheet
	dataSheet = ThisComponent.Sheets.getByName("aaa")
	
	'先掃描目前資料表(輸出資料表)，先建立字典Dict key => index(0開始算)
	Dim dict, count, i, t
	Set dict = CreateObject("Scripting.Dictionary")
	i = 1
	count = 0
	t = curSheet.getCellByPosition(0, i).String
	key = t & "/" & curSheet.getCellByPosition(1, i).string
	while t <> ""
		dict.Add key, count
		count = count + 1
		i = i + 1
		t = curSheet.getCellByPosition(0, i).String
		key = t & "/" & curSheet.getCellByPosition(1, i).String
	wend
	
	'建立陣列Arr，共有 count*3 個 Double 元素(因為有三種)
	Dim arr(count*3) As Double
	
	'開始掃描資料檔，如果符合 key 則存入 Arr[Dict[key]*3+type]
	Dim idx, tpy, val
	i = 1
	t = dataSheet.getCellByPosition(1, i).String
	key = t & "/" & dataSheet.getCellByPosition(3, i).string
	while t <> ""
		if dict.Exists(key) then
			idx = CInt(dict.Item(key))*3
			tpy = dataSheet.getCellByPosition(0, i).String
			val = dataSheet.getCellByPosition(4, i).Value
			if tpy = "FCST" then
				arr(idx) = arr(idx) + val
			elseif tpy = "SO" then
				arr(idx+1) = arr(idx+1) + val
			elseif tpy = "Ship" then
				arr(idx+2) = arr(idx+2) + val
			else
			endif
		endif
		i = i + 1
		t = dataSheet.getCellByPosition(1, i).String
		key = t & "/" & dataSheet.getCellByPosition(3, i).string
	wend
	
	'將 Arr 寫入到目前資料表
	Dim a,b,c
	for i=1 to count
		idx=(i-1)*3
		a=arr(idx)
		b=arr(idx+1)
		c=arr(idx+2)
		if curSheet.getCellByPosition(2, i).String = "N" And a > b + c then
			t=b+c
		else
			t=a
		endif
		curSheet.getCellByPosition(3, i).Value=t
		'curSheet.getCellByPosition(4, i).String= a & "/" & b & "/" & c
	next i
End Sub

試試看
如果可用再來看細節
如果不能用或一樣慢就忽略這程式吧

Sub FindInRange()
    i = 1
    cate1 = "FCST"
    cate2 = "SO"
    cate3 = "Ship"
    row1 = Cells(Rows.Count, 1).End(xlUp).Row
    
    
    'Debug.Print row1
    Do Until i >= row1
        i = i + 1
        Debug.Print i
        Bnum = Range("a" & i)
        
        a = 0
        b = 0
        c = 0
        With Worksheets("aaa").Range("b:b")
            Set Rng = .Find(Bnum, LookIn:=xlValues)
            If Not Rng Is Nothing Then
                firstAddress = Rng.Address
                Do
                    sType = Rng.Offset(0, -1).Value
                    If (sType = "FCST") Then
                        a = Rng.Offset(0, 3).Value
                    ElseIf (sType = "SO") Then
                        b = Rng.Offset(0, 3).Value
                    ElseIf (sType = "Ship") Then
                        c = Rng.Offset(0, 3).Value
                    End If
                    
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
            End If
        End With
                
        
        If Cells(i, 3) = "N" Then
            If a > b + c Then
                Cells(i, 4) = b + c
            Else
                Cells(i, 4) = a
            End If
        Else
            Cells(i, 4) = a
        End If
    
    Loop
End Sub