問題補(bǔ)充:從已有的齒輪庫(kù)中選取4個(gè)合適的齒輪abcd,并使a/b*c/d=傳動(dòng)比。例如:傳動(dòng)比0.43678,掛輪庫(kù)中有28?29?30------110等齒數(shù)的齒輪,要從中選取4個(gè),且a/b*c/d=0.43678....
推薦回答:110個(gè)組合4,然后逐個(gè)計(jì)算(A/B)*(c/d)萬(wàn)能的vba可以實(shí)現(xiàn)代碼如下:
PrivateSubCommandButton1_Click()DimsArr(1To1837620,1To4)AsInteger,SJSAsLongDimjgArr(1To1000,1To4)AsInteger,jgJsAsIntegerDimXLaRR(1To83)AsInteger,SZAsDoubleConstCDB=0.43678ForI=1To83XLaRR(I)=28+I-1NextISJS=0ForI=1To83-3ForJ=I+1To83-2ForK=J+1To83-1ForL=K+1To83SJS=SJS+1sArr(SJS,1)=XLaRR(I)sArr(SJS,2)=XLaRR(J)sArr(SJS,3)=XLaRR(K)sArr(SJS,4)=XLaRR(L)NextLNextKNextJNextI'計(jì)算jgJs=0ForM=1ToSJSSZ=sArr(M,1)/sArr(M,2)*(sArr(M,3)/sArr(M,4))IfAbs(CDB-SZ)<=0.0001thenjgjs=jgjs+1jgarr(jgjs,1)=sarr(m,1)jgarr(jgjs,2)=sarr(m,2)jgarr(jgjs,3)=sarr(m,3)jgarr(jgjs,4)=sarr(m,4)endifnextm'輸出結(jié)果ifjgjs>0ThenCells(1,1).Resize(jgJs,4)=jgArrEndIfEndSub運(yùn)行結(jié)果如圖:
如果有問題就加我好友。
追問非常感謝您的回答!我只需要列出需要的結(jié)果就可以了。
我想得到的結(jié)果是,從28-110掛輪庫(kù)中(這個(gè)只是舉例,實(shí)際上中間有的齒輪沒有。
也有的時(shí)候有2個(gè)以上相同的齒輪)選擇4個(gè)齒輪abcd,并且(a/b)*(c/d)=0.43678,列出1-10個(gè)完全或者近似等于0.43678的齒輪組合即可。
關(guān)于近似精度,可以設(shè)置一個(gè)選項(xiàng)。
比如精確到小數(shù)點(diǎn)后第5位或者第6位等。